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: [mg78579] Re: [mg78490] Working with factors of triangular numbers.
  • From: DrMajorBob <drmajorbob at bigfoot.com>
  • Date: Thu, 5 Jul 2007 03:51:00 -0400 (EDT)
  • References: <29834672.1183456615563.JavaMail.root@m35> <op.tuxlmvr4qu6oor@monster.ma.dl.cox.net>
  • Reply-to: drmajorbob at bigfoot.com

On second thought both codes fail, to different degrees, because the  

sequence isn't monotone. There's a "jump" from 13 to 17 distinct factors 
in the first-code results, while the second code found a number with  
maxFactor = 15, but none with 14 or 16 factors.

Here's a code, finally, that doesn't have those problems:

Clear[maxFactors, find]
maxFactors[n_Integer?Positive] :=
  Total@PartitionsQ@FactorInteger[n][[All, -1]]
find[1] = 1;
find[n_Integer?Positive] := Module[{i, k},
   i = 3;
   While[maxFactors[k = Binomial[i, 2] - 1] != n, i++];
   k + 1
   ]

Timing[find[20]]

{0.468, 134242305}

Timing[results = find /@ Range[20]]
{#, maxFactors[# - 1]} & /@ results // ColumnForm

{3.422, {1, 15, 55, 561, 1081, 8001, 29161, 131841, 293761, 525825,
   4723201, 2094081, 8382465, 169896961, 75515905, 411084801, 33542145,
    33566721, 134193153, 134242305}}

{
  {{1, maxFactors[0]}},
  {{15, 2}},
  {{55, 3}},
  {{561, 4}},
  {{1081, 5}},
  {{8001, 6}},
  {{29161, 7}},
  {{131841, 8}},
  {{293761, 9}},
  {{525825, 10}},
  {{4723201, 11}},
  {{2094081, 12}},
  {{8382465, 13}},
  {{169896961, 14}},
  {{75515905, 15}},
  {{411084801, 16}},
  {{33542145, 17}},
  {{33566721, 18}},
  {{134193153, 19}},
  {{134242305, 20}}
}

Sorry for the confusion!

Bobby

On Wed, 04 Jul 2007 03:24:21 -0500, DrMajorBob <drmajorbob at bigfoot.com> 

wrote:

> I think this does what you want (if I understand you correctly):
>
> Clear[maxFactors, find, found]
> found[1] = 1;
> found[_] = Infinity;
> maxFactors[n_Integer?Positive] :=
>   Total@PartitionsQ@FactorInteger[n][[All, -1]]
> find[1] = {1};
> find[n_Integer?Positive] := Module[{i, k, this},
>    i = 3;
>    While[(this = maxFactors[k = Binomial[i, 2] - 1]) <= n,
>     found[this] = Min[k + 1, found[this]];
>     i++];
>    Most[Last /@ DownValues@found]
>    ]
>
> Timing[find[20]]
>
> {1.625, {1, 15, 55, 561, 1081, 8001, 29161, 131841, 293761, 525825,
>    4723201, 2094081, 8382465, 169896961, 75515905, 411084801, 33542145,
>     33566721, 134193153, 134242305}}
>
> After that, "found" has stored the results:
>
> found /@ Range[20]
>
> {1, 15, 55, 561, 1081, 8001, 29161, 131841, 293761, 525825, 4723201, \
> 2094081, 8382465, 169896961, 75515905, 411084801, 33542145, 33566721, \
> 134193153, 134242305}
>
> That code starts with i = 3 all over again for each find[n], so I tried  
> to optimize that away:
>
> Clear[maxFactors, find, found]
> found[1] = 1;
> found[_] = Infinity;
> maxFound := DownValues[found][[-2, 1, 1]]
> maxFactors[n_Integer?Positive] :=
>   Total@PartitionsQ@FactorInteger[n][[All, -1]]
> find[1] = {1};
> find[n_Integer?Positive] := Module[{i, k, this},
>    i = Max[3, 1 + 1/2 (1 + Sqrt[1 + 8 maxFound])];
>    While[found[n] ==
>       Infinity && (this = maxFactors[k = Binomial[i, 2] - 1]) <==
 n,
>     found[this] = Min[k + 1, found[this]];
>     i++];
>    found /@ Range[n]
>    ]
>
> Timing[find[20]]
>
> {0.844, {1, 15, 55, 561, 1081, 8001, 29161, 131841, 293761, 525825,
>    4723201, 2094081, 8382465, \[Infinity], 75515905, \[Infinity],
>    33542145, 33566721, 134193153, 134242305}}
>
> found /@ Range[20]
>
> {1, 15, 55, 561, 1081, 8001, 29161, 131841, 293761, 525825, 4723201, \
> 2094081, 8382465, \[Infinity], 75515905, \[Infinity], 33542145, \
> 33566721, 134193153, 134242305}
>
> Timing[find[20]]
>
> {0., {1, 15, 55, 561, 1081, 8001, 29161, 131841, 293761, 525825,
>    4723201, 2094081, 8382465, \[Infinity], 75515905, \[Infinity],
>    33542145, 33566721, 134193153, 134242305}}
>
> It runs faster -- MUCH faster on a second invocation -- but notice, it 
> didn't find some of the values.
>
> Why? Well, that's because I thought the sequence would be monotone... 

> and it's not.
>
> After running again the one that works:
>
> found[14] < found[15]
>
> False
>
> Bobby
>
> On Tue, 03 Jul 2007 04:23:30 -0500, Diana <diana.mecum at gmail.com> 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.
>>
>>
>>
>
>
>



-- 

DrMajorBob at bigfoot.com


  • Prev by Date: Re: Re: The Mathematica Book, Electronic Media
  • Next by Date: Re: Simple but puzzling plotting question
  • Previous by thread: Re: Working with factors of triangular numbers.
  • Next by thread: Re: Working with factors of triangular numbers.