# Combining nested lists that meet certain criteria for a permutation

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.

-
Did you check Cycles[]? – Dr. belisarius Sep 23 '12 at 1:57
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? – Brandon Amos Sep 23 '12 at 2:07
Closely related to mathematica.stackexchange.com/questions/3234/…, although the code there seems to not like dealing with non-indexed vertices. – Brett Champion Sep 23 '12 at 2:29
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. – Daniel Lichtblau Sep 23 '12 at 19:51

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

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

-
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). – TomD Sep 23 '12 at 13:50
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. – DavidC Sep 23 '12 at 16:53
After quite a bit of confusion, I'm going to settle on this. Nicely answered and explained, David. – Brandon Amos Sep 23 '12 at 17:13
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] – TomD Sep 23 '12 at 17:14

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"} *)
`
-
@highphi, my pleasure. Welcome to Mma.SE. – kglr Sep 23 '12 at 2:39
@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). – kglr Sep 23 '12 at 3:57