TransWikia.com

How to express permutation as the least number of exchanges

Mathematica Asked on November 21, 2020

If there are grammatical or terminological errors in the following description, please help correct:

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*)

4 Answers

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

exchanges[v1_, v2_] := Select[MapIndexed[First[#2] -> #1 &, 
                                         LinearAlgebra`LAPACK`PermutationToPivot[
                                         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}

Correct answer by J. M.'s discontentment on November 21, 2020

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}

Answered by Hausdorff on November 21, 2020

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};

Answered by user1066 on November 21, 2020

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}

Answered by Ferca on November 21, 2020

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP