10
$\begingroup$

I have the following list representing a permutation on 26 characters:

{{G, G}, {O, P}, {V, L}, {Y, Y}, {C, X}, {H, I}, {P, S}, {W, R},
 {I, H}, {Q, D}, {X, C}, {J, B}, {D, M}, {K, O}, {R, N}, {Z, K},
 {L, Q}, {M, F}, {S, A}, {N, Z}, {A, T}, {E, U}, {T, W}, {B, V},
 {F, E}, {U, J}}

How can I "simplify" this list to show the cyclic form of the permutations? A possibility of the above list would be:

{{A, T, W, R, N, Z, K, O, P, S}, {B, V, L, Q, D, M, F, E, U, J},
 {C, X}, {G}, {H, I}, {Y}}

I'm new to Mathematica and I could write an ugly loop to do this, but I've noticed that Mathematica usually has elegant solutions for problems like this that I wouldn't be able to think of on my own. Thus, I haven't tried to do anything because I couldn't find anything while searching for this.


I could still be overlooking something, but I tried converting the list to numeral values with A=1 and I got the following error:

Cycles::reppoint: Cycles[{{7, 7}, {15, 16}, {22, 12},
  {25, 25}, {3, 24}, {8, 9}, {16, 19}, {23, 18}, {9, 8},
  {17, 4}, {24, 3}, {10, 2}, {4, 13}, {11, 15}, {18, 14},
  {26, 11}, {12, 17}, {13, 6}, {19, 1}, {14, 26}, {1, 20},
  {5, 21}, {20, 23}, {2, 22}, {6, 5}, {21, 10}}]
contains repeated integers.
$\endgroup$
4
  • 1
    $\begingroup$ Did you check Cycles[]? $\endgroup$ Sep 23, 2012 at 1:57
  • $\begingroup$ Looking at it now -- I'm having trouble understanding what format it should be in, but it looks like that will work if I convert the characters into character codes? $\endgroup$ Sep 23, 2012 at 2:07
  • $\begingroup$ Closely related to mathematica.stackexchange.com/questions/3234/…, although the code there seems to not like dealing with non-indexed vertices. $\endgroup$ Sep 23, 2012 at 2:29
  • 3
    $\begingroup$ Such questions were pondered in the Middle Ages and even antiquity. Remind's one of the infamous debates "How many permutations can dance on the head of a pin?" Or the adage "It is easier for a cycle to fit through the eye of a needle, than for a camel to get into heaven." Or words to that effect. $\endgroup$ Sep 23, 2012 at 19:51

2 Answers 2

11
$\begingroup$

My interpretation of your question is: What cycles describe the permutation from order1 to order2?

order1 = {"G", "O", "V", "Y", "C", "H", "P", "W", "I", "Q", "X", "J", "D", "K", "R", "Z", "L", "M", "S", "N", "A", "E", "T", "B", "F", "U"};
order2 = {"G", "P", "L", "Y", "X", "I", "S", "R", "H", "D", "C", "B", "M", "O", "N", "K", "Q", "F", "A", "Z", "T", "U", "W", "V", "E", "J"};

If that is indeed what you are asking, FindPermutation will give the cycles:

FindPermutation[order1, order2]

Cycles[{{2, 14, 16, 20, 15, 8, 23, 21, 19, 7}, {3, 24, 12, 26, 22, 25, 18, 13, 10, 17}, {5, 11}, {6, 9}}]


What the Cycles Represent

The following diagram shows the first cycle walk: {2, 14, 16, 20, 15, 8, 23, 21, 19, 7}. Note that the cycle forms a closed loop (position 7 connects to position 2).

cycle


Inferring the permutation from the cycles

Suppose we knew the original ordering and the cycles but didn't know the second ordering:

Permute[order1, Cycles[{{2, 14, 16, 20, 15, 8, 23, 21, 19, 7}, {3, 24, 12, 26, 22, 
25, 18, 13, 10, 17}, {5, 11}, {6, 9}}]]

{"G", "P", "L", "Y", "X", "I", "S", "R", "H", "D", "C", "B", "M", \ "O", "N", "K", "Q", "F", "A", "Z", "T", "U", "W", "V", "E", "J"}

% === order2

True

$\endgroup$
4
  • 2
    $\begingroup$ That is great to know! So datas[[All, 1]][[#]] & /@ (Cycles[{{2, 14, 16, 20, 15, 8, 23, 21, 19, 7}, {3,24, 12, 26, 22, 25, 18, 13, 10, 17}, {5, 11}, {6, 9}}][[1, All]]) (for example) will give how I interpreted the question (without the singletons). $\endgroup$
    – user1066
    Sep 23, 2012 at 13:50
  • $\begingroup$ Interesting. I see how the code produces your connected components but I'm still trying to understand your underlying thinking. Looks like you treated the ordered pairs as arrows. Actually, this is something like the arrows I drew in the explanation above! Yes, very interesting. $\endgroup$
    – DavidC
    Sep 23, 2012 at 16:53
  • $\begingroup$ After quite a bit of confusion, I'm going to settle on this. Nicely answered and explained, David. $\endgroup$ Sep 23, 2012 at 17:13
  • $\begingroup$ I have deleted my answer because, as highphi pointed out in a comment, StrongComponents does not do what is asked, (the order of the vertices are not the same as given by GraphPlot) and I consider the answer misleading. Extract Cycles might be worth considering (see here) Needs["Combinatorica"] Characters /@FromCharacterCode /@ ExtractCycles@FromOrderedPairs[Flatten /@ ToCharacterCode /@ datas]` $\endgroup$
    – user1066
    Sep 23, 2012 at 17:14
3
$\begingroup$

Here is a simpler example that illustrates the steps and built-in functions that can be used:

transpositionlist = {{1, 2}, {1, 5}, {3, 7}, {6, 8}, {6, 10}, {4, 4}, {9, 9}}
(* First delete elements corresponding to points fixed `{i,i}` *)
DeleteCases[transpositionlist, {x_, x_}];
(* Then make a cycle out  of each element. Combined with the previous step: *)
Cycles /@ List /@ DeleteCases[transpositionlist, {x_, x_}]
(* {Cycles[{{1, 2}}], Cycles[{{1, 5}}], Cycles[{{3, 7}}],  Cycles[{{6, 8}}], Cycles[{{6, 10}}]}*)
(* Take the `PermutationProduct` of these cycles. Again, with all steps combined:*)
PermutationProduct @@ (Cycles /@  List /@ DeleteCases[transpositionlist, {x_, x_}])
 (* Cycles[{{1, 2, 5}, {3, 7}, {6, 8, 10}}]*)

If needed,

PermutationList[Cycles[{{1, 2, 5}, {3, 7}, {6, 8, 10}}]]

gives the permutation of the original list:

(* {5, 1, 7, 4, 2, 10, 3, 6, 9, 8} *)

Update: A modifed version of your list

trlist1={{g, g}, {p, p}, {v, l}, {y, y}, {c, x}, {h, i}, {p, s}, 
 {w, r}, {i, h}, {q, d}, {x, c}, {j, b}, {d, m}, {k, o}, {r,n}, {z, k}, 
 {l, q}, {m, f}, {s, a}, {n, z}, {a, t}, {e, u}, {t, w}, {b, v}, {f, e}, {u, j}};

In order to use Cycles we need to convert the letters to integers. ArrayComponents is a convenient bulit-in that can be used for this purpose:

trlist2= ArrayComponents[trlist1]
(* {{1, 1}, {2, 2}, {3, 4}, {5, 5}, {6, 7}, {8, 9}, {2, 10}, {11, 12}, {9, 8},
  {13, 14}, {7, 6}, {15, 16}, {14, 17}, {18, 19}, {12, 20}, {21, 18},
  {4, 13}, {17, 22}, {10, 23}, {20, 21}, {23, 24}, {25, 26},
  {24, 11}, {16, 3}, {22, 25}, {26, 15}}*)

Then,

PermutationProduct @@ (Cycles /@   List /@ DeleteCases[trlist2, {x_, x_}])
(* Cycles[{{2, 11, 21, 18, 19, 20, 12, 24, 23, 10}, {3, 13, 25, 15},
     {4, 16, 26, 22, 17, 14}}]*)

And, using this permutation to permute CharacterRange["a", "z"]

Permute[CharacterRange["a", "z"], %]

we get

(* {"a", "j", "o", "n", "e", "f", "g", "h", "i", "w", "b", "t",
     "c", "q", "y", "d", "v", "u", "r", "s", "k", "z", "x", "l", "m", "p"} *)
$\endgroup$
2
  • $\begingroup$ @highphi, my pleasure. Welcome to Mma.SE. $\endgroup$
    – kglr
    Sep 23, 2012 at 2:39
  • $\begingroup$ @highphi, based on David's new and correct answer, you should consider your accept. My post is based on mis-interpreting the pairs in your list to stand for length-two cycles (whose product is the original 'unknown' permutation). $\endgroup$
    – kglr
    Sep 23, 2012 at 3:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.