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\$

migrated from stackoverflow.com May 10 '11 at 12:02

This question came from our site for professional and enthusiast programmers.

  • \$\begingroup\$ Welcome to CodeReview, Mr. :) \$\endgroup\$ – Dr. belisarius May 10 '11 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 '11 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\$ – Dr. belisarius May 10 '11 at 16:59
  • \$\begingroup\$ @belisarius That must have been quite an answer! O_O \$\endgroup\$ – Mr.Wizard May 10 '11 at 17:03
  • \$\begingroup\$ @Mr. Just luck stackoverflow.com/questions/3956478/understanding-randomness/… \$\endgroup\$ – Dr. belisarius May 10 '11 at 17:17
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\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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