4
$\begingroup$

As we know the definition of conjugate permutations is: $$\exists p \quad p^{-1} \alpha p=\beta$$ When I have an alpha=Cycles[{{1,4},{2,5,6,3}}] and a beta=Cycles[{{1,2,5,3},{4,6}}]. So how to use Mathematica to solve the $p$?

$\endgroup$
4
$\begingroup$

Another way of phrasing the question is "find $p$ such that $\alpha p = p \beta$."

Based on Arturo Magidin's answer here, one can list the cycles of $\alpha$ and $\beta$, with cycles of same length below one another, and then $p$ will be the permutation that takes the top row to the bottom row.

My implementation:

findP[Cycles[alpha_], Cycles[beta_]] :=
  Block[{p1, p2, ans},
  p1 = Flatten @ Sort @ alpha;
  p2 = Flatten @ Sort @ beta;
  ans = Table[0, {Length[p1]}];
  Do[ans[[p2[[i]]]] = p1[[i]], {i, Length[p1]}];
  PermutationCycles @ ans
]

Verification:

alpha = Cycles[{{1, 4}, {2, 5, 6, 3}}];
beta = Cycles[{{1, 2, 5, 3}, {4, 6}}];
p = findP[alpha, beta];
PermutationProduct[p, alpha] == PermutationProduct[beta, p]
(* True *)

Or like formulated in the OP:

PermutationProduct[p, alpha, InversePermutation[p]] == beta
(* True *)

Note the order in PermutationProduct, which is what the docs dictate. However, I find

p
(* Cycles[{{1, 2, 5, 6, 4}}] *)
$\endgroup$
  • 2
    $\begingroup$ Shorter: findP[Cycles[alpha_], Cycles[beta_]] := Block[{p1, p2}, p1 = Flatten @ Sort @ alpha; p2 = Flatten @ Sort @ beta; PermutationCycles[Permute[p1, PermutationCycles[p2]]]] $\endgroup$ – J. M. will be back soon Jun 3 '16 at 16:16
  • $\begingroup$ @J.M. How about p=Cycles[{{1,5,3},{2,7}}]; c1=Cycles[{{1,3},{4,7,6}}] c2=PermutationReplace[c1,p]? $\endgroup$ – yode Jun 3 '16 at 20:02
  • $\begingroup$ I found the findP cannot apply to any alpha and beta? $\endgroup$ – yode Jun 3 '16 at 20:03
  • 1
    $\begingroup$ It cannot apply to any alpha and beta, beause two conjugate permutations always have the same cyclic structure. My code does not check whether p exists or not, it just computes p assuming alpha and beta are conjugates. $\endgroup$ – Marius Ladegård Meyer Jun 3 '16 at 20:06
  • $\begingroup$ Yup,the c1 and c2 is conjugates actually :) $\endgroup$ – yode Jun 3 '16 at 20:13
1
$\begingroup$

The theoretical work from This post.


Happy to show my own finP.And I'm glad to seen another better solution can do this all the same. :)

findP[Cycles[c1_], Cycles[c2_]] := 
 Module[{l}, l = Sort /@ {c1, c2}; 
  PermutationCycles /@ 
   Map[Last, 
    Union[Transpose[Catenate /@ l], #] & /@ 
     Function[list, 
       Transpose[{First[list], #}] & /@ Permutations[Last[list]]][
      Complement[Range[Max[l]], Flatten[#]] & /@ l], {2}]]

Usage:

$\color{blue}{\text{First example}}$

findP[Cycles[{{1, 4}, {2, 5, 6, 3}}], Cycles[{{1, 2, 5, 3}, {4, 6}}]]

{Cycles[{{1,4,6,5,2}}]}

verification

PermutationProduct[InversePermutation[Cycles[{{1, 4, 6, 5, 2}}]], 
 Cycles[{{1, 4}, {2, 5, 6, 3}}], Cycles[{{1, 4, 6, 5, 2}}]]

Cycles[{{1, 2, 5, 3}, {4, 6}}]

$\color{blue}{\text{Second example}}$

twoP=findP[Cycles[{{1,3},{4,7,6}}],Cycles[{{1,5},{2,6,4}}]]

We get two $p$

{Cycles[{{2,3,5,7,6,4}}],Cycles[{{2,7,6,4},{3,5}}]}

verification

PermutationProduct[InversePermutation[#],Cycles[{{1,3},{4,7,6}}],#]&/@twoP

{Cycles[{{1,5},{2,6,4}}],Cycles[{{1,5},{2,6,4}}]}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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