Re: Re: Working with factors of triangular numbers.

*To*: mathgroup at smc.vnet.net*Subject*: [mg80059] Re: [mg79864] Re: Working with factors of triangular numbers.*From*: DrMajorBob <drmajorbob at bigfoot.com>*Date*: Sat, 11 Aug 2007 02:18:26 -0400 (EDT)*References*: <200707030923.FAA17995@smc.vnet.net> <24165820.1186478071750.JavaMail.root@m35> <op.twtzghhtqu6oor@monster.gateway.2wire.net> <f3a906a0708100741w2a6bb88bucd56de48bef52d37@mail.gmail.com> <10025410.1186769736558.JavaMail.root@m35>*Reply-to*: drmajorbob at bigfoot.com

Right you are!! That was a real blunder. I hadn't been keeping up with the thread, so I probably missed the best test cases and all that, but leaving out the factor 9 when there are no other powers of 3??? Terrible! Anyway, here's a fix, and it's as fast as before... maybe faster. Clear[factorCounts, nine] nine[{a___, {3, j_}, b___}] := {a, {3, j + 2}, b} nine[x_List] := Join[{{3, 2}}, x] factorCounts[1] = factorCounts[2] = factorCounts[3] = {1}; factorCounts[4] = {2}; factorCounts[7] = {3}; factorCounts[k_Integer] := If[EvenQ@k, factorCounts[(k + 2)/2, k - 1], factorCounts[(k - 1)/2, k + 2]] factorCounts[j_Integer, k_Integer] := Switch[GCD[j, k], 1, Join[FactorInteger@j, FactorInteger@k], 3, nine@Join[FactorInteger[j/3], FactorInteger[k/3]]][[All, -1]] // Sort Cases[Table[{chi, FactorInteger[chi*(chi + 1)/2 - 1], FactorInteger[chi*(chi + 1)/2 - 1][[All, 2]] // Sort, factorCounts[chi]}, {chi, 10^5}], {chi_, _, x_, y_} /; x =!= y] {} Clear[lldaux5, lld5, t5] lldaux5[{}] := 0 lldaux5[x_List] /; MemberQ[x, 1] := Count[x, 1] + lldaux5@DeleteCases[x, 1] lldaux5[Lpow_] := lldaux5[Lpow] = With[{Mtup = Tuples[Range[0, #] & /@ Lpow]}, Total[Quiet@ LinearProgramming[ConstantArray[-1, Length[Mtup]], Transpose@Mtup, Thread@{Lpow, 0}, Array[{0, 1} &, Length[Mtup]], Integers]] - 1] lld5[n_Integer] := lldaux5@factorCounts@n t5[n_] := # (# + 1)/2 &@NestWhile[# + 1 &, 2, lld5[#] < n &] T2c /@ Range[10] // Timing t5 /@ Range[10] // Timing {1.219, {3, 15, 55, 253, 1081, 13861, 115921, 665281, 18280081, 75479041}} {1.031, {3, 15, 55, 253, 1081, 13861, 115921, 665281, 18280081, 75479041}} T2c[11] // Timing t5[11] // Timing {3.641, 2080995841} {2.937, 2080995841} T2c[12] // Timing t5[12] // Timing {27.094, 68302634401} {16.922, 68302634401} Timing[lldaux5[FactorInteger[2^84*5^18*7^6][[All, 2]]]] {2.766, 26} T2c[13] // Timing t5[13] // Timing {151.953, 924972048001} {62.562, 924972048001} 48318396825601 t5[14] // Timing {503.907, 48318396825601} Bobby On Fri, 10 Aug 2007 10:32:15 -0500, Oleksandr Pavlyk <pavlyk at gmail.com> wrote: > By design factorCounts[n] should give the same as > > Sort[FactorInteger[ (n(n+1)/2) - 1][[All,2]]] > > Here are few cases where they disagree: > > In[134]:= Cases[ > Table[{chi, FactorInteger[chi*(chi + 1)/2 - 1][[All, 2]] // Sort, > factorCounts[chi]}, {chi, 100}], {chi_, x_, y_} /; x =!= y] > > Out[134]= \ > {{13,{1,1,2},{1,1}},{22,{1,2,2},{1,2}},{31,{1,1,2},{1,1}},{40,{1,1,2},= \ > {1,1}},{49,{1,2,3},{1,3}},{58,{1,1,1,2},{1,1,1}},{67,{1,1,2},{1,1}},{\= > 76,{1,2,2},{1,2}},{85,{1,1,1,2},{1,1,1}},{94,{1,2,4},{1,4}}} > > Oleksandr > > > On 8/10/07, Oleksandr Pavlyk <pavlyk at gmail.com> wrote: >> Hi, >> >> First of all, very nice work. >> >> It threw me off initially that lld5 did not work for my example: >> >> In[70]:= lld5[chi = 2^84*5^18*7^6] >> >> Out[70]= 14 >> >> In[71]:= lldaux5[FactorInteger[chi][[All, 2]] ] >> >> Out[71]= 26 >> >> But then I realize that factorCounts is supposed to work only for >> triangular numbers, >> as is implied by the link given in the mail, and I would like to >> explicitly state for the record: >> >> In[72]:= factorCounts[chi] >> >> Out[72]= {1,1,1,1,1,1,1,1,1,1,1,1,5} >> >> In[73]:= FactorInteger[chi] >> >> Out[73]= {{2,84},{5,18},{7,6}} >> >> Oleksandr Pavlyk >> >> On 8/10/07, DrMajorBob <drmajorbob at bigfoot.com> wrote: >> > Here's a significantly faster code (for n=12,13 anyway). >> > >> > Clear[lldaux5, lld5, t5, factorCounts] >> > factorCounts[1] = factorCounts[2] = factorCounts[3] = {1}; >> > factorCounts[4] = {2}; >> > factorCounts[7] = {3}; >> > factorCounts[k_Integer] := >> > If[EvenQ@k, factorCounts[(k + 2)/2, k - 1], >> > factorCounts[(k - 1)/2, k + 2]] >> > factorCounts[j_Integer, k_Integer] := >> > Switch[GCD[j, k], >> > 1, >> > Join[FactorInteger@j, FactorInteger@k], >> > 3, Replace[ >> > Join[FactorInteger[j/3], >> > FactorInteger[k/3]], {3, s_} :> {3, s + 2}, {1}]][[All, -1]] // >> > Sort >> > lldaux5[{}] := 0 >> > lldaux5[x_List] /; MemberQ[x, 1] := >> > Count[x, 1] + lldaux5@DeleteCases[x, 1] >> > lldaux5[Lpow_] := >> > lldaux5[Lpow] = >> > With[{Mtup = Tuples[Range[0, #] & /@ Lpow]}, >> > Total[Quiet@ >> > LinearProgramming[ConstantArray[-1, Length[Mtup]], >> > Transpose@Mtup, Thread@{Lpow, 0}, >> > Array[{0, 1} &, Length[Mtup]], Integers]] - 1] >> > lld5[n_Integer] := lldaux5@factorCounts@n >> > t5[n_] := # (# + 1)/2 &@NestWhile[# + 1 &, 2, lld5[#] < n &] >> > >> > T2c /@ Range[10] // Timing >> > t5 /@ Range[10] // Timing >> > >> > {0.422, {3, 15, 55, 253, 1081, 13861, 115921, 665281, 18280081, >> > 75479041}} >> > >> > {1.046, {3, 15, 55, 325, 1081, 18145, 226801, 665281, 18280081, >> > 75479041}} >> > >> > T2c[11] // Timing >> > t5[11] // Timing >> > >> > {1.625, 2080995841} >> > >> > {3.063, 2080995841} >> > >> > Timing differences aren't reliable either way for n<=11, but beyond >> that >> > it's a different story: >> > >> > T2c[12] // Timing >> > t5[12] // Timing >> > >> > {27., 68302634401} >> > >> > {17.187, 68302634401} >> > >> > T2c[13] // Timing >> > t5[13] // Timing >> > >> > {150.172, 924972048001} >> > >> > {64.032, 924972048001} >> > >> > t5[14] // Timing >> > >> > {516.546, 48318396825601} >> > >> > The trick (already used by someone else, I think) >> > >> > lldaux5[x_List] /; MemberQ[x, 1] := >> > Count[x, 1] + lldaux5@DeleteCases[x, 1] >> > >> > means that if the factor counts includes n ones, the LP problem used >> by >> > T2c has 2^n times as many variables as the one used by t5. Yet this >> > yielded only a 10-15% improvement, by itself. >> > >> > A bigger gain was achieved in factorCounts, based on one of Carl >> Woll's >> > ideas in >> > >> > http://forums.wolfram.com/mathgroup/archive/2007/Jul/msg00411.html >> > >> > factorCounts[k_Integer] := >> > If[EvenQ@k, factorCounts[(k + 2)/2, k - 1], >> > factorCounts[(k - 1)/2, k + 2]] >> > >> > Several fine adjustments were required to get any improvement at all. >> > Defining factorCounts for 1,2,3,4, and 7 removed steps from the code >> for >> > other cases, and it was crucial to take full advantage of the fact >> that >> > the GCD of the two factors could only be 1 or 3. >> > >> > Bobby >> > >> > On Tue, 07 Aug 2007 00:31:22 -0500, sashap <pavlyk at gmail.com> wrote: >> > >> > > On Aug 5, 3:58 am, Carl Woll <ca... at wolfram.com> wrote: >> > >> sashap wrote: >> > >> >Carl's code is very good on numbers not involving >> > >> >products of large powers of primes. Otherwise it >> > >> >it is memory intensive and not as efficient: >> > >> >> > >> >In[109]:= Table[Timing[LargestPartition[{k, k}]], {k, 7, 15}] >> > >> >> > >> >Out[109]= >> > >> >{{0.031,7},{0.141,7},{0.172,8},{0.187,9},{1.531,9},{1.875,10}, >> > >> >{12.016,10},{16.234,11},{141.391,11}} >> > >> >> > >> >One can use LinearProgramming to improve on the >> > >> >situation. >> > >> >> > >> >Additional improvement comes from the following >> > >> >observation. The longest factorization can be built >> > >> >by taking the longest sequence of divisors of degree 1, >> > >> >then of degree 2 and so on. The degree of the divisor >> > >> >is defined as >> > >> >> > >> > deg[n_] := Total[ FactorInteger[n][[All,2]] ] >> > >> >> > >> >In other words, let n == p1^e1 *...* pn^en. >> > >> >First take {p1, p2,.., pn}, then the longest >> > >> >sequence of pairs with repetitions and so on. >> > >> >> > >> Nice work! However, I think there is a problem with your algorit= hm. >> > >> There are many possible ways to a longest sequence of (distinct)= = >> pairs >> > >> with repetitions. It is possible that some of these sequences wi= ll = >> not >> > >> produce the longest factorization. For instance, consider 2^10 *= = >> 3^3 * >> > >> 5^2. After removing the degree 1 factors we are left with 2^9 * = = >> 3^2 * 5. >> > >> Two possible length 3 sequences of pairs are: >> > >> >> > >> a) 2^2, 2*3, 2*5 leaving 2^5*3 >> > >> >> > >> and >> > >> >> > >> b) 2^2, 2*3, 3*5 leaving 2^6 >> > >> >> > >> Now, for case a) we can create two more unique factors, 2^3 and = = >> 2^2*3, >> > >> while for case b) we can't create two more unique factors. >> > >> >> > >> So, I think one more thing is needed in your algorithm, a way of= = >> knowing >> > >> which longest sequence of pairs to pick. >> > >> >> > >> Now, it turns out that the above example is handled correctly by= = >> your >> > >> algorithm, that is, your algorithm by design or chance picks a = >> longest >> > >> sequence that leads to a longest factorization. I played around = = >> with a >> > >> bunch of different examples, and came up with one example where = = >> your >> > >> algorithm picks a longest sequence that doesn't lead to a longes= t >> > >> factorization. This wasn't easy because my algorithm is soo slow= = >> (but I >> > >> think, correct). >> > >> >> > >> In[594]:= counterexample = {2,3,4,5,6,7,8,10,12,14,15,35}; >> > >> >> > >> In[595]:= Times @@ counterexample >> > >> >> > >> Out[595]= 35562240000 >> > >> >> > >> In[596]:= Length[counterexample] >> > >> >> > >> Out[596]= 12 >> > >> >> > >> In[597]:= LengthOfLongestDecomposition[Times @@ counterexample= ] >> > >> >> > >> Out[597]= 11 >> > >> >> > >> My guess is that a simple heuristic probably exists which will = >> allow you >> > >> to pick a good longest sequence instead of a bad longest sequenc= e. >> > >> Perhaps something like choosing the longest sequence that keeps = as = >> many >> > >> different types of prime factors available for the next stage? I= f = >> so, >> > >> then the biggest bottleneck will be just factoring the triangula= r >> > >> numbers. >> > >> >> > >> Carl >> > >> >> > > >> > > Carl, >> > > >> > > good points ! Indeed: >> > > >> > > In[98]:= ffaux /@ Permutations[FactorInteger[chi][[All, 2]] ] >> > > >> > > Out[98]= {12,12,11,12,12,12,12,12,12,11,11,11} >> > > >> > > The heuristics you mention might be different sorting of exponent= s, >> > > even though we can not guarantee it, that is >> > > changing LengthOfLongestDecomposition to the following: >> > > >> > > LengthOfLongestDecomposition[nn_Integer] := >> > > ffaux[Reverse@Sort@FactorInteger[nn][[All, 2]]] >> > > >> > > Another approach is to write n == d1^s1 * ... * dk^sk and jus= t use >> > > LinearProgramming once. Here >> > > s1, ..., sk are either 0 or 1, and d1, ..., dk are all distinct >> > > divisors of the given integer n. >> > > >> > > Clear[lldaux, lld]; >> > > lldaux[Lpow_] := (lldaux[Lpow] = >> > > With[{Mtup = Tuples[ Range[0, #] & /@ Lpow]}, >> > > Total[ >> > > Quiet@LinearProgramming[ConstantArray[-1, Length[Mtup]], >> > > Transpose@Mtup, Thread@{Lpow, 0}, >> > > Array[{0, 1} &, Length[Mtup]], Integers]] - 1]) >> > > >> > > lld[n_Integer] := lldaux[FactorInteger[n][[All, 2]] // Sort] >> > > >> > > T2c[n_] := # (# + 1)/2 &@ >> > > NestWhile[# + 1 &, 2, lld[# (# + 1)/2 - 1] < n &] >> > > >> > > The performance of T2c is competitive to Carl's code for small = >> values >> > > of the argument >> > > and has an edge over it for large ones: >> > > >> > > In[168]:= {Timing@T2[11], Timing@T2c[11]} >> > > >> > > Out[168]= {{3.829,2080995841},{3.921,2080995841}} >> > > >> > > In[169]:= {Timing@T2[12], Timing@T2c[12]} >> > > >> > > Out[169]= {{26.532,68302634401},{22.797,68302634401}} >> > > >> > > In[170]:= {Timing@T2[13], Timing@T2c[13]} >> > > >> > > Out[170]= {{144.406,924972048001},{123.875,924972048001}} >> > > >> > > Oleksandr Pavlyk and Maxim Rytin >> > > >> > >> >In order to choose the longest sequence of factors of a given = >> degree, >> > >> >we set this up as an integer linear programming problem. We = >> illustrate >> > >> >this for degree 2. Let p1*p1, p1*p2, and so on be candidate = >> factors of >> > >> >degree 2. Then >> > >> >> > >> > (p1*p1)^s1 (p1*p2)^s2 ... >> > >> >> > >> >must divide the original number. Additionally, each sk is eithe= r = >> 0 or >> > >> >1. >> > >> >This gives us the constraints for variables s1, s2, ... and >> > >> >the objective function being maximized is s1+s2+.... >> > >> >> > >> >The code implementing those ideas: >> > >> >> > >> >CombinationsWithRepetitions = >> > >> > Compile[{{n, _Integer}, {k, _Integer}}, >> > >> > Module[{ans, i = 1, j = 1, l = 1}, >> > >> > ans = Array[0 &, {Binomial[n + k - 1, k], k}]; >> > >> > While[True, While[j <= k, ans[[i, j++]] = l]; >> > >> > If[i == Length@ans, Break[]]; >> > >> > While[ans[[i, --j]] == n,]; >> > >> > l = ans[[i++, j]] + 1; >> > >> > ans[[i]] = ans[[i - 1]];]; >> > >> > ans]]; >> > >> >> > >> >Clear[LengthOfLongestDecomposition, ffaux] >> > >> >LengthOfLongestDecomposition[nn_] := >> > >> > ffaux[Sort@FactorInteger[nn][[All, 2]]] >> > >> >ffaux[$Lpow_] := >> > >> > ffaux[$Lpow] = >> > >> > Module[{Lpow = $Lpow, Ldiv, n, m, k = 1, Lind, ans = 0}= , >> > >> > n = Length@Lpow; >> > >> > While[Total@Lpow >= k, >> > >> > Ldiv = CombinationsWithRepetitions[n, k++]; >> > >> > m = Length@Ldiv; >> > >> > Lind = >> > >> > Quiet@LinearProgramming[ConstantArray[-1, m], >> > >> > Total[1 - Unitize[Ldiv - #], {2}] & /@ Range@n, >> > >> > Thread@{Lpow, -1}, Array[{0, 1} &, m], Integers]; >> > >> > ans += Total@Lind; >> > >> > Lpow -= BinCounts[Flatten@Pick[Ldiv, Lind, 1], {Range[n = >> + 1]}]]; >> > >> > ans] >> > >> >> > >> >Compare the timing given earlier with the following >> > >> >> > >> >In[132]:= Table[Timing[ffaux[{k, k}]], {k, 7, 15}] >> > >> >> > >> >Out[132]= \ >> > >> = >> >{{0.016,7},{1.78746*10^-14,7},{1.78746*10^-14,8},{0.015,9},{3.15303*= \ >> > >> >10^-14,9},{0.016,10},{0.,10},{0.015,11},{0.,11}} >> > >> >> > >> >Clearly, the use of heavy machinery of LinearProgramming comes = at = >> the >> > >> >cost of >> > >> >noticeable overhead which is why the performance of this = >> algorithm is >> > >> >comparable >> > >> >to that of Carl's code when measured over a sequence of triangu= lar >> > >> >numbers because >> > >> >problematic numbers are rare. >> > >> >> > >> >T2b[n_] := # (# + 1)/2 &@ >> > >> > NestWhile[# + 1 &, 1, >> > >> > LengthOfLongestDecomposition[# (# + 1)/2 - 1] < n &] >> > >> >> > >> >In[66]:= {Timing[T2[11]], Timing[T2b[11]]} >> > >> >> > >> >Out[66]= {{3.172,2080995841},{2.328,2080995841}} >> > >> >> > >> >In[67]:= {Timing[T2[12]], Timing[T2b[12]]} >> > >> >> > >> >Out[67]= {{26.312,68302634401},{18.235,68302634401}} >> > >> >> > >> >In[68]:= {Timing[T2[13]], Timing[T2b[13]]} >> > >> >> > >> >Out[68]= {{142.765,924972048001},{111.422,924972048001}} >> > >> >> > >> >Oleksandr Pavlyk and Maxim Rytin >> > >> >> > >> >On Jul 10, 5:37 am, Carl Woll <ca... at wolfram.com> wrote: >> > >> >> > >> >>Andrzej and Diana, >> > >> >> > >> >>Here is a faster algorithm. First, an outline: >> > >> >> > >> >>For a given number, the easy first step in writing it as a >> > >> >>factorization of the most distinct factors is to use each prim= e = >> as a >> > >> >>factor. Then, the hard part is to take the remaining factors a= nd >> > >> >>partition them in a way to get the most distinct factors. = >> However, >> > >> note >> > >> >>that this step only depends on the counts of each prime factor= , = >> and >> > >> not >> > >> >>on the values of the primes themselves. Hence, we can memoize = the >> > >> number >> > >> >>of distinct factors possible for a set of counts. I do this as= >> > >> follows: >> > >> >> > >> >>Let f be the list of remaining factors, of length l. >> > >> >> > >> >>1. Determine possible integer partitions of l, with the smalle= st >> > >> >>partition allowed being 2. We also need to order these = >> partitions by >> > >> >>length, from largest to smallest: >> > >> >> > >> >>partitions = IntegerPartitions[l, All, Range[2, l]]; >> > >> >>partitions = Reverse@partitions[[ Ordering[Length/@partition= s] = >> ]]; >> > >> >> > >> >>2. Now, we need to test each partition to see if it's possible= = >> to fill >> > >> >>in the partitions with the factors such that each partition is= = >> unique. >> > >> >>Once we find such a partition, we are done, and we know how ma= ny >> > >> >>distinct factors that number can be written as. This step I do= by >> > >> >>recursion, i.e., take the first member of a partition and fill= = >> it in >> > >> >>with one of the possible subsets of factors, and then repeat = >> with the >> > >> >>remaining members of a partition. I do this with the function >> > >> Partition= >> > > able. >> > >> >> > >> >>Here is the code: >> > >> >> > >> >>LargestPartition[list : {1 ..}] := Length[list] >> > >> >>LargestPartition[list_List] := Length[list] + >> > >> >>LargestTwoPartition[Reverse@Sort@list - 1 /. {a__, 0 ..} -> {a= }] >> > >> >> > >> >>Clear[LargestTwoPartition] >> > >> >>LargestTwoPartition[list_] := LargestTwoPartition[list] == = >> Module[{= >> > > set, >> > >> >>partitions, res}, >> > >> >> set = CountToSet[list]; >> > >> >> partitions = IntegerPartitions[Total[list], All, Range[2,= = >> Total[li= >> > > st]]]; >> > >> >> partitions = Reverse@partitions[[Ordering[Length /@ = >> partitions]]]; >> > >> >> res = Cases[partitions, x_ /; Partitionable[{}, set, x], = 1, = >> 1]; >> > >> >> If[res === {}, >> > >> >> 0, >> > >> >> Length@First@res >> > >> >> ] >> > >> >>] >> > >> >> > >> >>Partitionable[used_, unused_, part_] := Module[{first, rest}= , >> > >> >> first = Complement[DistinctSubsets[unused, First@part], us= ed]; >> > >> >> If[first === {}, Return[False]]; >> > >> >> rest = CountToSet /@ Transpose[ >> > >> >> SetToCount[unused, Max[unused]] - >> > >> >> Transpose[SetToCount[#, Max[unused]] & /@ first] >> > >> >> ]; >> > >> >> Block[{Partitionable}, >> > >> >> Or @@ MapThread[ >> > >> >> Partitionable[Join[used, {#1}], #2, Rest[part]] &, >> > >> >> {first, rest} >> > >> >> ] >> > >> >> ] >> > >> >>] >> > >> >> > >> >>Partitionable[used_, rest_, {last_}] := ! MemberQ[used, rest= ] >> > >> >> > >> >>CountToSet[list_] := Flatten@MapIndexed[Table[#2, {#1}] &, l= ist] >> > >> >>SetToCount[list_, max_] := BinCounts[list, {1, max + 1}] >> > >> >> > >> >>DistinctSubsets[list_, len_] := Union[Subsets[list, {len}]] >> > >> >> > >> >>T2[n_] := Module[{k=1}, >> > >> >> While[k++; LargestPartition[FactorInteger[k*((k + 1)/2) - = >> 1][[All, >> > >> >>2]]] < n]; >> > >> >> k*((k + 1)/2) >> > >> >>] >> > >> >> > >> >>Then: >> > >> >> > >> >>In[11]:= T2[6] // Timing >> > >> >>Out[11]= {0.047,13861} >> > >> >> > >> >>In[12]:= T2[7] // Timing >> > >> >>Out[12]= {0.031,115921} >> > >> >> > >> >>In[13]:= T2[8] // Timing >> > >> >>Out[13]= {0.11,665281} >> > >> >> > >> >>In[14]:= T2[9] // Timing >> > >> >>Out[14]= {0.625,18280081} >> > >> >> > >> >>In[15]:= T2[10] // Timing >> > >> >>Out[15]= {1.157,75479041} >> > >> >> > >> >>In[16]:= T2[11] // Timing >> > >> >>Out[16]= {5.875,2080995841} >> > >> >> > >> >>In[17]:= T2[12] // Timing >> > >> >>Out[17]= {48.703,68302634401} >> > >> >> > >> >>For Diana, note that >> > >> >> > >> >>In[20]:= 481 482/2 - 1 == 115921 - 1 == 2 3 4 5 6 7 = 23 >> > >> >>Out[20]= True >> > >> >> > >> >>so 115921-1 can indeed be written as a product of 7 distinct = >> factors. >> > >> >> > >> >>Partitionable can be improved, but another bottleneck for larg= er = >> cases >> > >> >>is evaluating FactorInteger. One possibility for improving >> > >> FactorInteger >> > >> >>speed is to note that >> > >> >> > >> >>In[21]:= n (n + 1)/2 - 1 == (n + 2) (n - 1)/2 // Expand >> > >> >> > >> >>Out[21]= True >> > >> >> > >> >>So, rather than applying FactorInteger to n(n+1)/2-1 you can = >> instead >> > >> >>somehow combine FactorInteger[n+2] and FactorInteger[n-1]. >> > >> >> > >> >>At any rate, it takes a bit longer, but with enough patience o= ne = >> can >> > >> >>also find: >> > >> >> > >> >>In[53]:= 1360126 1360127/2 - 1 == 924972048001 - 1 === 2 3 4 = >> > > 5 6 7 10 11 >> > >> >>12 13 15 23 31 >> > >> >>Out[53]= True >> > >> >> > >> >>and >> > >> >> > >> >>In[56]:= 9830401 9830402/2 - 1 == 48318396825601 - 1 == = 2 3 = >> > > 4 5 6 8 9 >> > >> >>10 11 12 17 22 32 59 >> > >> >>Out[56]= True >> > >> >> > >> >>Carl Woll >> > >> >>Wolfram Research >> > >> >> > >> >>Andrzej Kozlowski wrote: >> > >> >> > >> >>>Well, I stayed up longer than I wanted and I think I have now= = >> fixed >> > >> >>>it, I hope for the final time. Here is the new FF: >> > >> >> > >> >>>FFF[n_] := Module[{u = FactorInteger[n], s, k, partialQ, = = >> finalQ, s= >> > > pace}, >> > >> >>> s = u[[All,2]]; k = Length[u]; partialQ[l_List] := >> > >> >>> And @@ Flatten[{Last[l] == Array[0 & , k] || >> > >> >>> !MemberQ[Most[l], Last[l]], Thread[Total[l] <= s = - = >> 1]}]; >> > >> >>> finalQ[l_List] := And @@ Flatten[{Last[l] == Array[= 0 & , k] = >> = >> > > || >> > >> >>> !MemberQ[Most[l], Last[l]], Total[l] == s - 1}]= ; >> > >> >>> space = >> > >> >> > >> ... >> > >> >> > >> read more =BB >> > > >> > > >> > > >> > > >> > >> > >> > >> > -- >> > DrMajorBob at bigfoot.com >> > >> > -- = DrMajorBob at bigfoot.com

**Re: Re: Working with factors of triangular numbers.**

**Re: hardware for Mathematica 6.0**

**Re: Re: Working with factors of triangular numbers.**

**Re: Re: Working with factors of triangular numbers.**