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:
f[165]
19
f[100100]
142
The code is relatively fast even for n as large as 10!
f[10!]//Timing
{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.
Edit:
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
Usage:
f[11!,500000,10^15]
(* 1026 *)
Now the problem is speeding this code up.
Subsets
all at once; take advantage of the third parameter ofSubsets
to generate a portion of the subsets and work with that. For exampleSubsets[Range@6, {3}, {1, 10}]
, thenSubsets[Range@6, {3}, {11, 20}]
. $\endgroup$