Permutations without using the built in function in Wolfram

Question

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.

Answer 1

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]

Answer 2

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]]