3
$\begingroup$

I would like replace the following code

With[{n = 5},
  Flatten[
    Table[Join @@ NestList[Abs@Differences@# &, {a, b, c, d, e}, n - 1] // Evaluate, 
      {a, #}, {b, #}, {c, #}, {d, #}, {e, #}] &[n (n + 1)/2], n - 1]]; // AbsoluteTiming
(*{0.551032, 759375}*)

with this

With[{n = 5},
  Join @@ NestList[Abs@Differences@# &, #, n - 1] & /@ 
    Tuples[Range[n (n + 1)/2], n]]; // Timing

but the second method is much slower than the first. How can I make it fast?

$\endgroup$
4
  • $\begingroup$ Um...to make the rewrite as fast as the original you could just go back and use the original code, right? What is the purpose of rewriting the code and what are the design objectives for the rewrite? $\endgroup$
    – whuber
    Apr 9, 2013 at 17:29
  • 2
    $\begingroup$ @whuber If n=3 or n=4, I have to modify more about original code. $\endgroup$
    – chyanog
    Apr 9, 2013 at 17:38
  • 1
    $\begingroup$ I see--you have hard-coded the dimensions in the first version and wish to make the code more flexible. $\endgroup$
    – whuber
    Apr 9, 2013 at 17:44
  • 2
    $\begingroup$ @chyanog Can you elaborate more of what you want to achieve with this piece of code? $\endgroup$
    – Spawn1701D
    Apr 9, 2013 at 19:23

2 Answers 2

1
$\begingroup$

Since you already have fast code, we can find ways to automate the writing of that code. Rather than direct meta-programming reproduction of your code, which might be done using Unique, I shall give similarly fast code using Array that is somewhat easier to write (shorter).

With[{n = 5},
  Array[
    Evaluate[Join @@ NestList[Abs@Differences@# &, Slot ~Array~ n, n - 1]] &,
    ConstantArray[n (n + 1)/2, n]
  ] ~Flatten~ (n - 1)
] // Timing // First

0.406

Your second code can be made faster by rewriting it to pre-evaluate the function body, and into a form that can auto-compile in Map. The only method I could think of to do this is rather convoluted, and the result is not as fast as the code above, but here it is for the sake of interest:

With[{n = 5},
  (Evaluate[Join @@ NestList[Abs@Differences@# &, Slot ~Array~ n, n - 1]] & /. 
      Slot[x_] :> #[[x]]
  ) /@ Tuples[Range[n (n + 1)/2], n]
] // Timing // First

0.749

$\endgroup$
2
  • 1
    $\begingroup$ Now I know a new fast method,With[{n = 5}, Evaluate[ Flatten@NestList[Abs@Differences@# &, Array[Slot, n], n - 1]] & @@ Transpose@Tuples[Range[n (n + 1)/2], n] // Transpose]; // Timing $\endgroup$
    – chyanog
    May 5, 2013 at 14:06
  • $\begingroup$ @chyanog very nice! $\endgroup$
    – Mr.Wizard
    May 5, 2013 at 15:38
1
$\begingroup$
n = 5;
var = Table[Symbol["x" <> ToString@i], {i, n}]
t1 = Flatten@NestList[Abs@Differences@# &, var, n - 1]
t2 = Table[{i, 1, n (n + 1)/2}, {i, var}]
(Table[##] & @@ Join[{t1}, t2])~Flatten~(n - 1) // Length // AbsoluteTiming

{0.546031, 759375}

$\endgroup$

Your Answer

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

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