How the solve the parameter of the conjugate permutations

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$?

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}}] *)
• Shorter: findP[Cycles[alpha_], Cycles[beta_]] := Block[{p1, p2}, p1 = Flatten @ Sort @ alpha; p2 = Flatten @ Sort @ beta; PermutationCycles[Permute[p1, PermutationCycles[p2]]]] Jun 3 '16 at 16:16
• @J.M. How about p=Cycles[{{1,5,3},{2,7}}]; c1=Cycles[{{1,3},{4,7,6}}] c2=PermutationReplace[c1,p]?
– yode
Jun 3 '16 at 20:02
• I found the findP cannot apply to any alpha and beta?
– yode
Jun 3 '16 at 20:03
• 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. Jun 3 '16 at 20:06
• Yup,the c1 and c2 is conjugates actually :)
– yode
Jun 3 '16 at 20:13

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