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.

I want to speed up my code, i.e., replace Select by Pick. I think using two Pick expressions isn't pretty, but I have no good idea on how to combine them.

Select[Permutations@ Range@9,  
  #1 < #4 < #7 && #1/(10 #2 + #3) + #4/(10 #5 + #6) + #7/(10 #8 + #9) == 1 & @@ # &]

Pick[#, #1/(10 #2 + #3) + #4/(10 #5 + #6) + #7/(10 #8 + #9) & @@ Transpose @ #, 1] & @
  Pick[#, Thread[#1 < #4 < #7] & @@ Transpose@#] & @ Permutations @ Range @ 9 
share|improve this question
    
"I think two Pick isn't pretty..." - sure, but at least the second Pick[] has less to choose from, which is a good thing. –  J. M. May 3 '13 at 16:47

3 Answers 3

up vote 3 down vote accepted

One way to speed things up is to use internally fast functions ("vectorized" ones).

Another consideration is that machine-size integer arithmetic is faster than exact rational arithmetic. If we clear denominators in the second criteria it turns out to be faster.

pickCriteria = Compile[{{perms, _Integer, 2}},
  #[[1]] #[[5]] #[[6]] + #[[2]] #[[4]] #[[6]] + #[[3]] #[[4]] #[[5]] - #[[4]] #[[5]] #[[6]] &[
     {{1, 0, 0, 0, 0, 0, 0, 0, 0},   (* equals part 1 *)
      {0, 0, 0, 1, 0, 0, 0, 0, 0},   (* equals part 4 *)
      {0, 0, 0, 0, 0, 0, 1, 0, 0},   (* equals part 7 *)
      {0, 10, 1, 0, 0, 0, 0, 0, 0},  (* equals 10 * part 2 + part 3 *)
      {0, 0, 0, 0, 10, 1, 0, 0, 0},  (* equals 10 * part 5 + part 6 *)
      {0, 0, 0, 0, 0, 0, 0, 10, 1}   (* equals 10 * part 8 + part 9 *)
     } . Transpose @ perms]
  ];
Pick[#, Thread[#[[1]] < #[[4]] < #[[7]]] &@ Transpose@#] &@
    Pick[#, pickCriteria[#], 0] &@ Permutations @ Range @ 9 // Timing
  (* {0.134507, {{5, 3, 4, 7, 6, 8, 9, 1, 2}}} *)

The OP's two versions take 1.795493 and 0.873528 seconds respectively.

Real arithmetic is also fast, but approximate. A little bit slower than the above.

pickCriteriaReal = Compile[{{perms, _Real, 2}},
   Sign @ Chop[#[[1]]/#[[4]] + #[[2]]/#[[5]] + #[[3]]/#[[6]] - 1.] &[
        {{1.`, 0.`, 0.`, 0.`, 0.`, 0.`, 0.`, 0.`, 0.`},
         {0.`, 0.`, 0.`, 1.`, 0.`, 0.`, 0.`, 0.`, 0.`},
         {0.`, 0.`, 0.`, 0.`, 0.`, 0.`, 1.`, 0.`, 0.`},
         {0.`, 10.`, 1.`, 0.`, 0.`, 0.`, 0.`, 0.`, 0.`},
         {0.`, 0.`, 0.`, 0.`, 10.`, 1.`, 0.`, 0.`, 0.`},
         {0.`, 0.`, 0.`, 0.`, 0.`, 0.`, 0.`, 10.`, 1.`}
      } . Transpose @ perms]
  ];
Pick[#, Thread[#[[1]] < #[[4]] < #[[7]]] &@ Transpose @ #] &@
     Pick[#, pickCriteriaReal[#], 0] &@ Permutations @ N @ Range @ 9 // 
  Round // Timing
  (* {0.205289, {{5, 3, 4, 7, 6, 8, 9, 1, 2}}} *)
share|improve this answer
    
Thanks for help. Machine-size integer indeed fast, this also take 0.2 seconds: Pick[#, #1 (10 #5 + #6) (10 #8 + #9) + 10 #2 ((10 #5 + #6) (#7 - 10 #8 - #9) + #4 (10 #8 + #9)) + #3 ((10 #5 + #6) (#7 - 10 #8 - #9) + #4 (10 #8 + #9)) & @@ Transpose@#, 0] &@Permutations@Range@9 // Timing –  chyaong May 4 '13 at 18:01

Replaced by one equivalent Pick, but the net result is a slowdown ...

Pick[#, #1 < #4 < #7 && #1/(10 #2 + #3) + #4/(10 #5 + #6) + #7/(10 #8 + #9) == 1 & @@@ #] &@
                                                                         Permutations@Range@9
share|improve this answer
Pick[#, Sign[(#1 - #4)] + Sign[(#4 - #7)] +
  #1/(10.0 #2 + #3) + #4/(10.0 #5 + #6) +#7/(10.0 #8 + #9) & @@ 
    Transpose@#, 1. - 2] &@ Permutations@Range@9 // Timing

(*{1.138807, {{5, 3, 4, 7, 6, 8, 9, 1, 2}}}*)

More faster version (Thanks @Michael E2):

Pick[#, Function[{a, b, c, d, e, f, g, h, i},
  Evaluate[ Sign[a - d] + Sign[d - g] + 
    Simplify[a/(10 b + c) + d/(10 e + f) + g/(10 h + i) - 1 // Together // Numerator]]
  ] @@ Transpose@#, -2] &@Permutations@Range@9 // Timing

  (*{0.218401, {{5, 3, 4, 7, 6, 8, 9, 1, 2}}}*)

Or

Pick[#, Function[{a, b, c, d, e, f, g, h, i},
        Evaluate@Simplify[a/(10 b + c) + d/(10 e + f) + g/(10 h + i) - 1 // Together //
            Numerator]] @@ Transpose@#, 0] &@
    Pick[#, Sign[(#1 - #4)] + Sign[(#4 - #7)] & @@ Transpose@#, -2] &@
  Permutations@Range@9 // Timing

(*{0.109201, {{5, 3, 4, 7, 6, 8, 9, 1, 2}}}*)
share|improve this answer
    
Yours takes 0.067 sec. on my machine -- much faster than mine. The use of Sign[#1-#4] etc. in place of Less saves a lot of time, I think. –  Michael E2 May 4 '13 at 18:48

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.