Re: Working with factors of triangular numbers.
- To: mathgroup at smc.vnet.net
- Subject: [mg78617] Re: [mg78490] Working with factors of triangular numbers.
- From: DrMajorBob <drmajorbob at bigfoot.com>
- Date: Thu, 5 Jul 2007 04:10:44 -0400 (EDT)
- References: <29834672.1183456615563.JavaMail.root@m35> <op.tuxlmvr4qu6oor@monster.ma.dl.cox.net> <op.tuxn51adqu6oor@monster.ma.dl.cox.net> <8301158.1183557699908.JavaMail.root@m35>
- Reply-to: drmajorbob at bigfoot.com
You got me there, Diana!
Bobby
On Wed, 04 Jul 2007 08:56:59 -0500, Diana Mecum <diana.mecum at gmail.com>
wrote:
> Dr. Major Bob,
>
> Thanks for your time.
>
> The fourth term should be 253.
>
> a(4) = 2*3*6*7 +1= 253
>
> Thanks, Diana M.
>
> On 7/4/07, DrMajorBob <drmajorbob at bigfoot.com> wrote:
>>
>> 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
>>
>
>
>
--
DrMajorBob at bigfoot.com