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*)
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 Thread
to 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
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP