2
\$\begingroup\$

I want the fastest way in Mathematica 7 to generate a list of the factors (not prime factors) of an integer into a specified number of terms, with each factor greater than one.

For example, 240 into three terms:

{{2,2,60}, {2,3,40}, {2,4,30}, {2,5,24}, {2,6,20}, {2,8,15}, {2,10,12},
 {3,4,20}, {3,5,16}, {3,8,10}, {4,4,15}, {4,5,12}, {4,6,10}, {5,6,8}}

My starting code is based on a recursive method the source of which I have forgotten, but probably someone on projecteuler.net:

f[n_, 1, ___] := {{n}}

f[n_, k_, x_: 2] :=
 Join @@ Table[
   If[q < x, {}, {q, ##} & @@@ f[n/q, k - 1, q]],
   {q, # ~Take~ ⌈Length@#/k⌉ & @ Divisors @ n}
 ]

f[240, 3]

Memoization can be applied in several places. In the case of large integers this is much faster, at the expense of memory usage of course. Here, with memoization at three points:

Clear[f, div]

div@n_ := div@n = Divisors@n

div[n_, k_] := div[n, k] = # ~Take~ ⌈Length@#/k⌉ & @ div @ n

f[n_, 1, ___] := {{n}}

f[n_, k_, x_: 2] := f[n, k, x] =
 Join @@ Table[
   If[q < x, {}, {q, ##} & @@@ f[n/q, k - 1, q]],
   {q, n~div~k}
  ]

Compared to Sasha's code on a large composite integer:

f[10080^2, 5] // Length // Timing
   {0.891, 103245}
FactorIntoFixedTerms[10080^2, 5] // Length // Timing
   {25.594, 103245}

Can this be further improved?

\$\endgroup\$
6
  • \$\begingroup\$ Welcome to CodeReview, Mr. :) \$\endgroup\$ May 10, 2011 at 12:51
  • \$\begingroup\$ @belisarius why don't you have the Gold badge for "math" tag on StackOverflow? You seem to have more than enough votes! \$\endgroup\$
    – Mr.Wizard
    May 10, 2011 at 16:39
  • \$\begingroup\$ @Mr. I'm not sure, but I guess it is because you need to have posted at least 200 answers in that tag. Most of my votes come from only one answer \$\endgroup\$ May 10, 2011 at 16:59
  • \$\begingroup\$ @belisarius That must have been quite an answer! O_O \$\endgroup\$
    – Mr.Wizard
    May 10, 2011 at 17:03
  • \$\begingroup\$ @Mr. Just luck stackoverflow.com/questions/3956478/understanding-randomness/… \$\endgroup\$ May 10, 2011 at 17:17

1 Answer 1

6
\$\begingroup\$

Because Divisor is quite efficient at its job, the only optimization I see, is to avoid unnecessary calls to it, by using memoization technique:

FactorIntoFixedTerms[in_Integer, terms_Integer] := Block[{f, div},
  div[n_] := (div[n] = Divisors[n]);
  f[n_, 1] := {{n}}; 
  f[n_, k_] := 
   Join @@ Table[{q, ##} & @@@ 
      Select[f[n/q, 
        k - 1], #[[1]] >= 
         q &], {q, #[[2 ;; \[LeftCeiling]Length@#/
             k\[RightCeiling]]] &@div@n}];
  f[in, terms]
  ]

This can lead to substantial timing reduction:

In[683]:= FactorIntoFixedTerms[1453522322112240, 6] // Length // Timing

Out[683]= {0.047, 47}

In[685]:= foriginal[1453522322112240, 6] // Length // Timing

Out[685]= {0.39, 47}
\$\endgroup\$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.