Since I'm fairly new to Mathematica, I'm trying to learn better ways to improve my coding skills so I've turned to Project Euler and this site to speed up my learning pace. Anyways, I was trying to solve problem 32 on the project Euler forum and came up with the following code

PanDigital[n_, m_] := Sort[Flatten[IntegerDigits /@ {n, m, n m}]] == Range[9];

Module[{k}, k = Select[Flatten[Table[{i j, PanDigital[i, j]}, {i, 2, 9}, {j, 1234, 
      9876}] ~Join~ Table[{i j, PanDigital[i, j]}, {i, 12, 98}, {j, 123, 987}], 
     1], #[[2]] == True &]; k = Union@Select[Flatten[k], IntegerQ] // Total] // Timing

{2.620817, 45228}

By the way here is the question:

We shall say that an n-digit number is pandigital if it makes use of all the digits 1 to n exactly once; for example, the 5-digit number, 15234, is 1 through 5 pandigital.

The product 7254 is unusual, as the identity, 39 × 186 = 7254, containing multiplicand, multiplier, and product is 1 through 9 pandigital.

Find the sum of all products whose multiplicand/multiplier/product identity can be written as a 1 through 9 pandigital.

HINT: Some products can be obtained in more than one way so be sure to only include it once in your sum.

My question is, how can I make this code better, in terms of style and speed. I imagine using things like Reap and Sow could improve the readability and also speed. Also while my code run in under 3 seconds, I saw other people claiming less than 10 milliseconds time. Of course, using ParallelTable decreased the time to about 0.6 seconds on my PC but this is still not comparable to those times. Any advise is greatly appreciated.

  • $\begingroup$ project euler for mma? brilliant, I'll join you in that quest $\endgroup$ Feb 14, 2013 at 5:48

2 Answers 2

Union @@ Table[
    If[a*b <= 9876 && 
      Union[IntegerDigits[a], IntegerDigits[b], IntegerDigits[a*b]] ==
        Range[9], a*b, 0], {a, 123, 1987}, {b, 2, 98}] // Tr // Timing

(*v7*)(*{0.686, 45228}*)
(*v8*)(*{0.078, 45228}*)
  • $\begingroup$ Impressive. 0.0624 on my machine (V9). $\endgroup$
    – RunnyKine
    Feb 14, 2013 at 6:36
  • 1
    $\begingroup$ Your code is super fast, but I came up with a tiny improvement: Timing[Block[{r9=Range[9]},Total[Union@@Table[Block[{ida=IntegerDigits[a]},Table[If[a b<=9876&&Sort[Join[ida,IntegerDigits[b],IntegerDigits[a b]]]==r9,a b,0],{b,2,98}]],{a,123,1987}]]]]. (*{0.040,45228}*) vs (*{0.064,45228}*) $\endgroup$
    – Xerxes
    Feb 14, 2013 at 6:50
  • 2
    $\begingroup$ In the time it took to optimize this by another 8 milliseconds, you could have run the code 66000 times. Timing[Block[{r9=Range[9]},Total[DeleteDuplicates[Join@@Table[Block[{r9a=Complement[r9,IntegerDigits[a]],bmax=Quotient[9876,a]},Table[If[b<bmax&&Sort[Join[IntegerDigits[b],IntegerDigits[a b]]]==r9a,a b,0],{b,2,98}]],{a,123,1987}]]]]] (*0.032,45228*) $\endgroup$
    – Xerxes
    Feb 14, 2013 at 7:34
  • 2
    $\begingroup$ @Xerxes The results are machine-dependent. My timing (3.33 GHz Xeon W3580, MMA 8.0) is 0.031 seconds for chyanog's solution and 0.265 for your best one. $\endgroup$
    – whuber
    Feb 14, 2013 at 18:50
  • $\begingroup$ @whuber For such a large effect, version dependence seems more likely. I optimized on v9. $\endgroup$
    – Xerxes
    Feb 14, 2013 at 21:43

I'm really uncomfortable with hosting solutions to Project Euler problems here, but apparently the community feels otherwise.

I'll remark that it is often best to find the smallest set that encompasses the problem and test those cases. For example, you could consider only the numbers that might be products and then test those to see if they can be formed as the product of the remaining digits. This allows for about an order of magnitude improvement over your code I believe.

In light of the argument presented in the comments I shall go against my usual policy and post my solution using the principle described above.

test =
   Union @@@ Table[#[[{i, -i}]], {i, 2, Length@#/2}] &@IntegerDigits@Divisors@FromDigits@#,
   Range@9 ~Complement~ #
 ] &;

FromDigits /@ Select[
  TakeWhile[Reverse@Range@9 ~Permutations~ {4}, # =!= {3, 1, 8, 5} &],
] // Tr
  • 5
    $\begingroup$ I thought hard about that before asking this question but I convinced myself with the following: If anybody is looking to learn programming or Math through Project Euler and they decide to look for an easy way out by searching for answers before trying out the problems, they're only deceiving themselves. There's such thing as self-control and I believe information should be made free and not hoarded because a few people decide to cheat. $\endgroup$
    – RunnyKine
    Feb 14, 2013 at 6:43
  • $\begingroup$ I agree that working backwards from possible products is attractive, but I can find no way to make it work in this case: the raw speed of Times, IntegerDigits, and Union eclipse any gains to be had from checking divisibility. $\endgroup$
    – whuber
    Feb 14, 2013 at 18:53
  • $\begingroup$ @whuber what code with "Times, IntegerDigits, and Union" are you using? $\endgroup$
    – Mr.Wizard
    Feb 14, 2013 at 18:55
  • 1
    $\begingroup$ @whuber 3185 is the smallest number that could be a product. You use simply Select[Range@9 ~Permutations~ {4}, test] (and in fact I did exactly that in my original solution before reading the PE forum) with only a little loss of speed. $\endgroup$
    – Mr.Wizard
    Feb 14, 2013 at 22:16
  • 1
    $\begingroup$ To be fair, you should include the time to do such precomputations in the total. (The other solvers should similarly justify any special values that needed precomputation--conceivably 98, 123, and 987 are among them, unless they could be easily derived during the preliminary analysis.) $\endgroup$
    – whuber
    Feb 14, 2013 at 22:27

Your Answer

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

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