1
$\begingroup$

I suspect this is a really silly question but for the life of me, I am unable to figure out how to define a function that creates all the permutations of a given list. I know I can use the Permutation function but I wanted to code for myself. I remember doing it in school, where I used C++. I tried implementing the same recursive algorithm in Mathematica as well but I am just unable to do so. Any help would be much appreciated.

PS: I have tried using loops and NestedList but unfortunately I am not clever enough to make it work it would seem.

Edit:To be honest I wanted to see if there is a way to see how built in functions are coded in Mathematica but I suspect that is proprietary information.

$\endgroup$
1
4
$\begingroup$

I wouldn't use this as an example to learn functional programming in general or the Wolfram Language. But since you asked, I'll give an honest example of what a quick implementation would look like for me:

insertAtAllLocations[lst_, val_] := 
 Map[Insert[lst, val, #] &] @ Range[Length@lst + 1]

insertAtAllLocations takes a list and a value and returns a list of all possible lists where val has been inserted. Take a look at the output of:

insertAtAllLocations[Range[3], "a"]

Now we can define permutations recursively. If we have the permutations for a list of length n-1 we can build the permutations for a list of length n by running insertAtAllLocations on all permutations of length n-1.

permutations[1] := {{1}}

permutations[n_] := 
 Flatten[#, 1] &@
  Map[insertAtAllLocations[#, n] &]@
   permutations[n - 1]]

Compare permutations[4] // Sort and Permutations[Range[4]

$\endgroup$
1
  • $\begingroup$ That is excellent thank you so much! I understand it is not the way to learn functional programming but I just put it in my head i needed to figure it out and I couldn't. Thank you for the explanation! $\endgroup$ – Sisko Nov 5 '19 at 22:24
2
$\begingroup$

Using recursion

Clear[perm]
perm[L_, 0] := {{}};
perm[L_, n_] := Join @@ Table[a~Join~{b}, {a, perm[L, n - 1]}, {b, Complement[L, a]}];

perm[Range[9], 9] == Permutations[Range[9], {9}] // AbsoluteTiming

Output

{1.57136, True}

Using Nest

Clear[perm]
perm[L_, n_] := Nest[Join @@ Table[a~Join~{b}, {a, #}, {b, Complement[L, a]}] &, {{}}, n]
perm[Range[9], 9] == Permutations[Range[9], {9}] // AbsoluteTiming

Output

{1.57021, True}

Faster version using Meta-programming and Compile. It is worth noting,compiling into C code also takes time. related link Permutations[Range[12]] produces an error instead of a list

Clear[perm];
perm[n_, k_] :=
 Module[{X, cf, ans},
  X = Symbol["x" <> ToString[#]] &;
  cf = {Array[X, k], 
     Table[{X[i + 1], 
       If[Or @@ Table[X[i] == X[j - 1], {j, 2, i}], 0, 
        Evaluate@If[i < k, n, 1]]}, {i, k}]} /.
    {A_, {iter__}} :>
     Compile[{{x1, _Integer}},
      Module[{B = Internal`Bag[Rest@{0}]},
       Do[Internal`StuffBag[B, A, 1], iter];
       Internal`BagPart[B, All]~Partition~k],
      RuntimeAttributes -> {Listable}, CompilationTarget -> "C", RuntimeOptions -> "Speed"
      ];
  Print["Executing time: ", First[AbsoluteTiming[ans = Join @@ cf[Range[n]]]]];
  ans
  ]

perm[9, 9] == Permutations[Range[9], {9}]

Output

Executing time: 0.0468677
True

If you feel a little confused, you can start with following code

Flatten[Table[{x1, x2, x3, x4},
  {x1, 4}, 
  {x2, 4},
  {x3, If[x2 == x1, 0, 4]}, 
  {x4, If[x3 == x1 || x3 == x2, 0, 4]}, 
  {x5, If[x4 == x1 || x4 == x2 || x4 == x3, 0, 1]}], 4] == 
Permutations[Range[4]]
$\endgroup$
1
  • $\begingroup$ This is quite the thorough explanation thank you so much! $\endgroup$ – Sisko Nov 6 '19 at 11:25

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.