4
$\begingroup$

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 
$\endgroup$
  • $\begingroup$ "I think two Pick isn't pretty..." - sure, but at least the second Pick[] has less to choose from, which is a good thing. $\endgroup$ – J. M. will be back soon May 3 '13 at 16:47
3
$\begingroup$

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}}} *)
$\endgroup$
  • $\begingroup$ 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 $\endgroup$ – chyanog May 4 '13 at 18:01
4
$\begingroup$
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}}}*)
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Michael E2 May 4 '13 at 18:48
2
$\begingroup$

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
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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