As we know the definition of conjugate permutations is: ∃pp−1αp=β
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?Answer
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}]]
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}}]
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}}]}
Comments
Post a Comment