# Efficient code for building a big list

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?

• 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? Apr 9 '13 at 17:29
• @whuber If n=3 or n=4, I have to modify more about original code. Apr 9 '13 at 17:38
• I see--you have hard-coded the dimensions in the first version and wish to make the code more flexible. Apr 9 '13 at 17:44
• @chyanog Can you elaborate more of what you want to achieve with this piece of code? Apr 9 '13 at 19:23

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

• 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 May 5 '13 at 14:06
• @chyanog very nice! May 5 '13 at 15:38
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}