MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Working with factors of triangular numbers.

  • To: mathgroup at smc.vnet.net
  • Subject: [mg78723] Re: [mg78490] Working with factors of triangular numbers.
  • From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
  • Date: Sat, 7 Jul 2007 06:14:41 -0400 (EDT)
  • References: <200707030923.FAA17995@smc.vnet.net>

On 3 Jul 2007, at 18:23, Diana wrote:

> Math folks,
>
> I first generate a list of triangular numbers:
>
> 1, 3, 6, 10, 15, 21, ...
>
> and then subtract one from each as:
>
> 0, 2, 5, 9, 14, 20, ...
>
> I am trying to find the smallest triangular number (minus one) which
> can be written as a product of "n" distinct factors, each factor > 1.
>
> For example:
>
> a(2) = 15, because 2*7 + 1 = 15.
> a(3) = 55, because 2*3*9 + 1 = 55.
>
> I have worked with Divisors and FactorInteger, but am getting bogged
> down with repeated terms. Can someone think of a neat trick to work
> this problem?
>
> Diana M.
>
>

I wil start with a grumble. Unfortunately your problem is not, in my  
judgment, solvable by means of any nice mathematics, because you do  
not require the factors to be mutually prime, that is, not to be  
divisible by the same prime. Without that one can't make use of  
uniqueness of prime decomposition and that in this kind of problems  
generally means that brute force has to be used. (I have a much nicer  
solution of the same problem when the factors are required to be  
mutually prime)

So now I will present a 'brute force" argument, whose main virtue is  
that it can be much improved (but I will not do so). I will use the  
combinatorica package, which, in Mathematica 6.0 is loaded like this:

<< Combinatorica`

I want to make use of the Backtrack function in this package. (This  
is the main weakness of this approach and the point which can be  
greatly improved). Here is an auxiliary function, which uses  
backtracking:

FF[n_] := Module[{u = FactorInteger[n], s, k, partialQ, finalQ,  
space, sp},
    s = u[[All,2]]; k = Length[u]; sp[m_] := Tuples[Range[0, m], {k}];
     partialQ[l_List] := And @@ Flatten[
        { !MemberQ[IdentityMatrix[k], Last[l]], Last[l] == Array[0  
& , k] ||
           !MemberQ[Most[l], Last[l]], Thread[Total[l] <= s - 1]}];
     finalQ[l_List] := And @@ Flatten[{ !MemberQ[IdentityMatrix[k],  
Last[l]],
         Last[l] == Array[0 & , k] ||  !MemberQ[Most[l], Last[l]],
         Thread[Total[l] == s - 1]}]; space = sp /@ (s - 1);
     k + Max[0, Length /@ DeleteCases[Backtrack[space, partialQ,  
finalQ, All],
         Array[0 & , k], Infinity]]]

For any positive integer n this computes the length of the largest  
factorization of n into distinct factors. For example:

FF[2*3*9*11]
  4

which is obviously right. There is some minor problem in the code  
that causes a Part error message to appear sometimes, without however  
affecting the result:

FF[3]
Part::partw:Part 2 of {1} does not exist. >>
Part::partw:Part 2 of ( {
    {{0}}
   } ) does not exist. >>
Set::partw:Part 2 of {1} does not exist. >>
1

However, I don't to spend time on trying to find out the cause of  
this message so on my main program I will simply suppress all messages:

So now here is the main function T:

T[n_] := Block[{k = 1, $Messages}, While[k++; FF[k*((k + 1)/2) - 1] < n,
      Null]; k*((k + 1)/2)]

which for a given n looks for the smallest triangular number with n- 
distinct factors:

  Map[T, Range[8]]
{3, 15, 55, 253, 1081, 13861, 115921, 1413721}

I can't say that this is really fast, but the good news is that it  
certainly could be greatly improved. The Combinatorica general- 
purpose Backtrack function is very slow, and if someone writes a  
custom-made backtracking version suited to the problem at hand and  
compiles it, it will certainly become orders of magnitude faster.  
This has been done on this list in various situations several times.  
Unfortunately I can't spare the time necessary to do this. .  Writing  
backtracking programs requires careful procedural programming and I  
am really out of practice in procedural programming, but there are  
several excellent examples in the archives written by Fred Simons and  
Maxim Rytin, and if this is important for you, you should either  
learn to do it yourself by studying these programs or persuade one of  
them to do it for you ;-)

Andrzej Kozlowski


------------------------------------------
Your proposition may be good
But let's have one thing understood --
Whatever it is, I'm against it!
And even when you've changed it or condensed it,
I'm against it.

Professor Quincy Adams Wagstaff
President of Huxley College


  • Prev by Date: Re: a transparent persistence layer for Mathematica
  • Next by Date: Re: Working with factors of triangular numbers.
  • Previous by thread: Working with factors of triangular numbers.
  • Next by thread: Re: Working with factors of triangular numbers.