# How to express permutation as the least number of exchanges

In some problems, it is necessary to find out what minimum number of exchanges can change a list into another list.

For example, if list {a, b, c, 1, 2, 3, 4, 5} becomes List {3, 4, 5, 1, 2, a, b, c}, we need at least to swap the positions of a and 3,b and 4,c and 5. I want to get this result: {1->6,2->7,3->8}(position exchange information).

 FindPermutation[{a, b, c, 1, 2, 3, 4, 5}, {3, 4, 5, 1, 2, a, b, c}]


But the result returned above is in the form of Cycles. what can I do to get the desired result?

This knowledge point is very common when finding the inverse ordinal number of the arrangement in linear algebra.

Other examples for testing:

  FindPermutation[{a, b, c, 1, 2, 3, 4, 5}, {1, 2, 3, 4, a, 5, b, c}]
(*the answer should be in the form of {1 -> 4, 2 -> 5, 3 -> 6, 4 -> 7, 6 -> 8, 5 -> 7}, but I'm not sure if it is the shortest*)


There is some undocumented functionality you can use for the purpose:

exchanges[v1_, v2_] := Select[MapIndexed[First[#2] -> #1 &,
LinearAlgebraLAPACKPermutationToPivot[
InversePermutation[PermutationList[
FindPermutation[v1, v2]]]]], Apply[Unequal]]


For instance,

exchanges[{a, b, c, 1, 2, 3, 4, 5}, {3, 4, 5, 1, 2, a, b, c}]
{1 -> 6, 2 -> 7, 3 -> 8}

exchanges[{a, b, c, 1, 2, 3, 4, 5}, {1, 2, 3, 4, a, 5, b, c}]
{1 -> 4, 2 -> 5, 3 -> 6, 4 -> 7, 5 -> 7, 6 -> 8}


The following should give you valid permutations, though I am not sure whether they are always minimal. At least for your second example I get the same number of swaps.

Swaps[orig_, final_] :=
Rule @@@ (Sequence@@Partition[#,2,1]& /@ First@FindPermutation[final, orig])

Swaps[{a, b, c, 1, 2, 3, 4, 5}, {3, 4, 5, 1, 2, a, b, c}]

{1->6,2->7,3->8}

Swaps[{a, b, c, 1, 2, 3, 4, 5}, {1, 2, 3, 4, a, 5, b, c}]

{1->4,4->7,7->2,2->5,3->6,6->8}

Swaps[{a, b, c, 1, 2, 3, 4, 5}, {3, 4, 5, 2, a, 1, b, c}]

{1->6,6->4,4->5,2->7,3->8}


You could use PermutationList to convert the permutation from cycle format to a list format.

Define the input and output lists

list1 = {a, b, c, 1, 2, 3, 4, 5};
list2 = {3, 4, 5, 1, 2, a, b, c};


Compute the permutation associated to go from list1 to list2 in cycle form.

permcyc = FindPermutation[list1, list2]

Now convert the permutation to list form with PermutationList

permlst = PermutationList[permcyc]

Finally, you could use Threadto illustrate the position exchange information:

Thread[Range[Length[list1]] -> permlst]
{1 -> 6, 2 -> 7, 3 -> 8, 4 -> 4, 5 -> 5, 6 -> 1, 7 -> 2, 8 -> 3}


My first attempt at an answer was abysmally bad, and this (as a Community wiki) is merely a personal take on the neat answer given by Hausdorff

  swaps=Partition[#,2,1]&/@
First@InversePermutation[FindPermutation[start, want2]]//Catenate


{{1, 4}, {4, 7}, {7, 2}, {2, 5}, {3, 6}, {6, 8}}

The individual swaps may be visualized as follows:

 FoldList[Permute[#,Cycles[{#2}]] &, start, swaps]//TeXForm


$$\left( \begin{array}{cccccccc} a & b & c & 1 & 2 & 3 & 4 & 5 \\ 1 & b & c & a & 2 & 3 & 4 & 5 \\ 1 & b & c & 4 & 2 & 3 & a & 5 \\ 1 & a & c & 4 & 2 & 3 & b & 5 \\ 1 & 2 & c & 4 & a & 3 & b & 5 \\ 1 & 2 & 3 & 4 & a & c & b & 5 \\ 1 & 2 & 3 & 4 & a & 5 & b & c \\ \end{array} \right)$$

where

start={a, b, c, 1, 2, 3, 4, 5};
want2={1, 2, 3, 4, a, 5, b, c};