Re: Working with factors of triangular numbers.
- To: mathgroup at smc.vnet.net
- Subject: [mg78571] Re: [mg78490] Working with factors of triangular numbers.
- From: DrMajorBob <drmajorbob at bigfoot.com>
- Date: Wed, 4 Jul 2007 05:42:04 -0400 (EDT)
- References: <29834672.1183456615563.JavaMail.root@m35>
- Reply-to: drmajorbob at bigfoot.com
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