18 ms·

I came up with my own algorithm and found several speedups, but I haven't written an expanded article yet. I've implemented it in Julia, but Julia's built-in fa

I came up with my own algorithm and found several speedups, but I haven't written an expanded article yet. I've implemented it in Julia, but Julia's built-in factoring is (unfortunately) far slower than Sage's. A short preliminary article: http://angrystatistician.blogspot.com/2014/08/learn-this-one-weird-trick-and-easily.html http://angrystatistician.blogspot.com/2014/08/learn-this-one... Here's the Sage code: https://github.com/octonion/puzzles/tree/master/product-sum https://github.com/octonion/puzzles/tree/master/product-sum I'd be curious to see the speed of the corresponding Mathematica or Maple code.

kgwgk 12y ago
The Mathematica code below is roughly comparable to your vanilla version. Using a 2013 iMac (3.2 GHz Intel Core i5) I get the following timings for Sage/Mathematica (Mathematica gets more competitive for larger problems): 10^8 22s 65s 10^9 225s 635s 10^11 14h20 16h05 However, I found that Sage seems to calculate divisors faster than Mathematica for large numbers. The following are the times to sum the divisors of one million numbers starting at 10^8, 10^9, 10^10, 10^11: Sage: 18s, 21s, 24s, 27s Mathematica: 12s, 14s, 28s, 49s Solutions[pSum_, pProd_] := With[{term = 1 + pSumpProd}, With[{div = Divisors[term]}, Map[Function[x, If[Mod[x + 1, pProd] == 0, (1 + {x, term/x})/pProd, ## &[]]], Take[div, Ceiling[Length[div]/2]]]]] WithNonOneValues[n_, nval_] := Last[Reap[If[nval == 0, Sow /@ Solutions[n - 2, 1], Module[{val = Array[2 &, nval], idx = 1}, While[idx <= nval, With[{pSum = Plus @@ val + n - nval - 2, pProd = Times @@ val}, If[pSum + 2val[[1]] < pProd*val[[1]]^2, If[(++idx) <= nval, val[[Range[idx]]] = val[[idx]] + 1], Map[Function[x, If[Min[x] >= val[[1]], Sow[Flatten[{x, val}], ## &[]]]], Solutions[pSum, pProd]]; idx = 1; val[[1]] = val[[1]] + 1]]]]]]] AllSolutions[n_] := Flatten[Map[Function[x, WithNonOneValues[n, x]], Range[0, Log2[n]]], 2]

kgwgk 12y ago

The Mathematica code below is roughly comparable to your vanilla version. Using a 2013 iMac (3.2 GHz Intel Core i5) I get the following timings for Sage/Mathematica (Mathematica gets more competitive for larger problems): 10^8 22s 65s 10^9 225s 635s 10^11 14h20 16h05 However, I found that Sage seems to calculate divisors faster than Mathematica for large numbers. The following are the times to sum the divisors of one million numbers starting at 10^8, 10^9, 10^10, 10^11: Sage: 18s, 21s, 24s, 27s Mathematica: 12s, 14s, 28s, 49s Solutions[pSum_, pProd_] := With[{term = 1 + pSumpProd}, With[{div = Divisors[term]}, Map[Function[x, If[Mod[x + 1, pProd] == 0, (1 + {x, term/x})/pProd, ## &[]]], Take[div, Ceiling[Length[div]/2]]]]] WithNonOneValues[n_, nval_] := Last[Reap[If[nval == 0, Sow /@ Solutions[n - 2, 1], Module[{val = Array[2 &, nval], idx = 1}, While[idx <= nval, With[{pSum = Plus @@ val + n - nval - 2, pProd = Times @@ val}, If[pSum + 2val[[1]] < pProd*val[[1]]^2, If[(++idx) <= nval, val[[Range[idx]]] = val[[idx]] + 1], Map[Function[x, If[Min[x] >= val[[1]], Sow[Flatten[{x, val}], ## &[]]]], Solutions[pSum, pProd]]; idx = 1; val[[1]] = val[[1]] + 1]]]]]]] AllSolutions[n_] := Flatten[Map[Function[x, WithNonOneValues[n, x]], Range[0, Log2[n]]], 2]