Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
project euler for mma? brilliant, I'll join you in that quest –  Adam Dreaver Feb 14 '13 at 5:48

2 Answers 2

up vote 7 down vote accepted
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}*)
share|improve this answer
    
Impressive. 0.0624 on my machine (V9). –  RunnyKine Feb 14 '13 at 6:36
1  
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]},Tabl‌​e[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}*) –  Xerxes Feb 14 '13 at 6:50
2  
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=Comple‌​ment[r9,IntegerDigits[a]],bmax=Quotient[9876,a]},Table[If[b<bmax&&Sort[Join[Integ‌​erDigits[b],IntegerDigits[a b]]]==r9a,a b,0],{b,2,98}]],{a,123,1987}]]]]] (*0.032,45228*) –  Xerxes Feb 14 '13 at 7:34
1  
@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. –  whuber Feb 14 '13 at 18:50
    
@whuber For such a large effect, version dependence seems more likely. I optimized on v9. –  Xerxes Feb 14 '13 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 =
 MemberQ[
   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} &],
  test
] // Tr
share|improve this answer
5  
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. –  RunnyKine Feb 14 '13 at 6:43
    
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. –  whuber Feb 14 '13 at 18:53
    
@whuber what code with "Times, IntegerDigits, and Union" are you using? –  Mr.Wizard Feb 14 '13 at 18:55
1  
@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. –  Mr.Wizard Feb 14 '13 at 22:16
1  
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.) –  whuber Feb 14 '13 at 22:27

Your Answer

 
discard

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

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