Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

Let n be a positive integer. An integer triple (a, b, c) is called a factorisation triple of n if:

1 ≤ a ≤ b ≤ c
a·b·c = n.

Define f(n) to be a + b + c for the factorisation triple (a, b, c) of n which minimises c / a. One can show that this triple is unique.

For example, f(165) = 19, f(100100) = 142 and f(20!) = 4034872.

Find f(43!).

Above is the question. You can see my solution below:

 f[n_] := Module[{lis1, lis2, lis3, pos, cand, filt}, 
      lis1 = Subsets[Divisors[n], {3}]; lis2 = Times @@@ lis1; 
      pos = Position[lis2, n]; cand = Extract[lis1, pos]; 
      filt = ( #[[3]] / #[[1]] ) & /@ cand; 
      Plus @@ (Extract[cand, Position[filt, Min[filt]]] // Flatten)]

Let's test it:





The code is relatively fast even for n as large as 10!


{2.698817, 462}

The problem arises if I try to compute f[20!], I run out of memory. Any tips to circumvent this memory issue will be greatly appreciated. I know my code is straight-up brute force and certainly not the best way to go about this, but it gives the right answer when it works (doesn't run out of memory). Also, the idea is to get the answer in about a minute or less. Thanks.


Ok, so I've made progress with the memory issue using Mr. Wizard's advise in the comment. Of course it's still going to be slow unless one can find a way to generate only Subsets for which the product of the elements equals n. It would be great if Subsets had a 4th Option that accepts predicates. For now here's the updated code:

f[n_, incr_, end_] := 
 Module[{lis1, pos, cand = {}, filt, div = Divisors[n]}, 
   Do[lis1 = 
     Select[Subsets[div, {3}, {i, i + incr}] // Quiet, Times @@ # == n &]; 
    cand = {cand, lis1}, {i, 1, end, incr}]; 
   cand = Flatten[cand] ~ Partition ~ 3; 
   filt = ( #[[3]] / #[[1]] ) & /@ cand; 
   Plus @@ (Extract[cand, Position[filt, Min[filt]]] // Flatten)] ~
  Monitor ~ i



(* 1026 *)

Now the problem is speeding this code up.

share|improve this question
Don't generate your Subsets all at once; take advantage of the third parameter of Subsets to generate a portion of the subsets and work with that. For example Subsets[Range@6, {3}, {1, 10}], then Subsets[Range@6, {3}, {11, 20}]. – Mr.Wizard Mar 24 '13 at 1:35
@Mr.Wizard, thanks for the tip, I'll work on that now. – RunnyKine Mar 24 '13 at 1:38
Rather than generating all three-element subsets of divisors--the vast majority of which will not yield a product equal to $n$--think about how to generate a smaller list of candidates. Isn't the main point of Project Euler to get you to think about the nature of the problem rather than apply inefficient brute force tactics? – whuber Mar 24 '13 at 2:55
Also might want to have a peek here. It's a similar problem at heart (for all I know motivated by the same PE problem). – Daniel Lichtblau Mar 24 '13 at 3:28
@Federico, with all due respect I completely understand the whole point of PE. My question initially asked about the memory issues which in fact has been solved thanks to input from Mr. Wizard. What you don't understand about PE is that in most cases a brute-force approach helps you realize where the bottleneck is and where you need to focus more. Whenever I ask PE questions it's usually to learn how to improve my Mathematica skills. Thanks. – RunnyKine Mar 25 '13 at 2:23

Your Answer


By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.