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