Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
CommutativityPlot[group_, OptionsPattern[]] :=
Module[{els, n, CycleLengths, ConjClasses, conjClasses, ConjClass,
ConjClassId, colorList, conjugacyClassColor, regularGridColor,
notCommutingColor, commutingColor, indexed, ConjClassSeparator,
tickers, markers, mx},
els = GroupElements[group];
n = Length[els];
(* Initial sorting of elements provides a good approximation for \
sorting by conjugacy class,
and provides a sorting for the conjugacy classes themselves *)
CycleLengths[c_] := Sort[Length /@ c[[1]]];
els = SortBy[GroupElements[group],
Function[g, {CycleLengths[g], g}]];
(* Calculating and sorting by conjugacy classes *)
ConjClass[g_, el_] := GroupOrbits[g, {el}];
ConjClasses[g_] := DeleteDuplicates[
Table[
{ConjClass[g, GroupElements[g][[i]]]},
{i, 1, GroupOrder[g]}
]
];
conjClasses = ConjClasses[group];
ConjClassId[el_] :=
Position[conjClasses, {ConjClass[group, el]}][[1]][[1]];
els = SortBy[GroupElements[group], Function[g, {ConjClassId[g], g}]];
(************** Formattings ****************)
colorList = ColorData[45, "ColorList"];
conjugacyClassColor = colorList[[5]];
regularGridColor = colorList[[10]];
commutingColor = colorList[[3]];
notCommutingColor = colorList[[7]];
indexed = Thread[{Range[n], els}];
(* Red grid lines for conjugacy classes *)
ConjClassSeparator[p_] := Not[
p[[1]] + 1 > Length[indexed] ||
p[[1]] + 1 <= Length[indexed] &&
ConjClassId[indexed[[p[[1]]]][[2]]] ==
ConjClassId[indexed[[p[[1]] + 1]][[2]]]];
ticks = If[OptionValue["Ticks"], True, False];
permutationNames = OptionValue["PermutationNames"];
tickers = If[ticks,
Function[p,
If[
ConjClassSeparator[p], {p[[1]],
conjugacyClassColor}, {p[[1]], {regularGridColor, Dashed}}]] /@
indexed,
Function[p, {p[[1]], conjugacyClassColor}] /@
Select[indexed, ConjClassSeparator]
];
(* Setting up markers with nice formatting of the permutations *)
markers = If[ticks,
FormatCycle[c_] :=
If[c == Cycles[{{}}], "( )",
StringReplace[
StringJoin[ToString /@ c[[1]]], {"{" -> "(", "}" -> ")",
"," -> ""}]];
If[Length[permutationNames] > 0,
Function[
x, {x[[1]],
FormatCycle[x[[2]]] <> " " <> permutationNames[x[[2]]] } ] /@
indexed,
Function[x, {x[[1]], FormatCycle[x[[2]]]} ] /@ indexed
],
Automatic
];(* Function[x, If[OddQ[First[x]], x, {x[[1]],""} ]] /@
indexed;*)
mx = ArrayReshape[Map[Function[ab,
PermutationProduct[ab[[1]], ab[[2]]] ==
PermutationProduct[ab[[2]], ab[[1]]]], Tuples[els, 2]], {n, n}];
Return[
MatrixPlot[mx, Mesh -> {tickers, tickers},
ColorRules -> {True -> commutingColor,
False -> notCommutingColor},
FrameTicks -> {markers,
Map[Function[v, {v[[1]], Rotate[v[[2]], 90 Degree]}], markers]}]]
](* end module*)
CommutatorPlot[QuaternionGroup, \
{"PermutationNames" -> quaternionPermutationNames}]
CommutatorPlot[PauliGroup, {"PermutationNames" ->
pauliGroupPermutationNames}]
CommutatorPlot[DihedralGroup[10]]
CommutatorPlot[SymmetricGroup[4]]
CommutatorPlot[CyclicGroup[4]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment