Re: Working with factors of triangular numbers.
- To: mathgroup at smc.vnet.net
- Subject: [mg78594] Re: [mg78490] Working with factors of triangular numbers.
- From: "Diana Mecum" <diana.mecum at gmail.com>
- Date: Thu, 5 Jul 2007 03:58:48 -0400 (EDT)
- References: <29834672.1183456615563.JavaMail.root@m35>
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
>
--
"God made the integers, all else is the work of man."
L. Kronecker, Jahresber. DMV 2, S. 19.