# Replace Do loop with Nest

a1 = {1, 2, 3, 4};
Do[a2 = DeleteCases[a1, x1];
Do[a3 = DeleteCases[a2, x2];
Do[a4 = DeleteCases[a3, x3];
Do[Sow@{x1, x2, x3, x4};
, {x4, a4}]
, {x3, a3}]
, {x2, a2}]
, {x1, a1}] // Reap // Last


I would like replace my code with Nest, I have tried this

a1 = {1, 2, 3, 4};
Nest[Table[{i, j}, {i, a1}, {j, DeleteCases[#, i]}]~Flatten~1 &, a1, 3]


but it worked incorrect.

• Why don't you use simply Permutations[{1, 2, 3, 4}] ??? Commented Oct 18, 2013 at 18:09
• Like this : Select[Tuples[a1, 4], Length@Union@# == 4 &]
– xyz
Commented Oct 19, 2013 at 15:34
• @Tangshutao Your method consume too much memory, also Select[Tuples[Range@4, 4], Unequal @@ # &] Commented Oct 19, 2013 at 17:39
• @chyaong,+1,Thank you!Your method also takes less time.
– xyz
Commented Oct 20, 2013 at 4:25

You can write something like this

a1 = {1, 2, 3, 4};
Nest[Flatten[Outer[Append, {#}, Complement[a1, #], 1] & /@ #, 2] &, Transpose@{a1}, 3]

{{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 2, 4}, {1, 3, 4, 2}, {1, 4, 2, 3},
{1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 4, 1},
{2, 4, 1, 3}, {2, 4, 3, 1}, {3, 1, 2, 4}, {3, 1, 4, 2}, {3, 2, 1, 4},
{3, 2, 4, 1}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 1, 2, 3}, {4, 1, 3, 2},
{4, 2, 1, 3}, {4, 2, 3, 1}, {4, 3, 1, 2}, {4, 3, 2, 1}}


However, as Artes pointed out it is the same as Permutations

 % == Permutations[a1]


True

a1 = {1, 2, 3, 4};
Nest[Table[{a}~Join~b, {a, a1}, {b, Select[#, FreeQ[#, a] &]}]~Flatten~1 &, {{}}, Length@a1]


{{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 2, 4}, {1, 3, 4, 2}, {1, 4, 2, 3}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {2, 4, 1, 3}, {2, 4, 3, 1}, {3, 1, 2, 4}, {3, 1, 4, 2}, {3, 2, 1, 4}, {3, 2, 4, 1}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 1, 2, 3}, {4, 1, 3, 2}, {4, 2, 1, 3}, {4, 2, 3, 1}, {4, 3, 1, 2}, {4, 3, 2, 1}}