# How to get the action diagram when the group act on a set?

I previously thought the orbital map would achieve this, but as the current answer or discuss in the comment. I realized that was wrong. And the Close behavior advice tells me "Needs details or clarity". So I re-edited the post.

As the textbook, when the $$S_3$$ can act on the root of $$x^3-2$$. The action diagram will be:

So Could we get the action diagram when the group act on a set by MMA?

# appendix

And there is the second example, and the set about subgroups of $$S_3$$ is

S = {{Cycles[{}]}, {Cycles[{}], Cycles[{{1, 2, 3}}],
Cycles[{{1, 3, 2}}]}, {Cycles[{}], Cycles[{{1, 2}}]}, {Cycles[{}],
Cycles[{{2, 3}}]}, {Cycles[{}], Cycles[{{1, 3}}]}};


But I'm worried it will make this post chaos, so I offer it here as an appendix

• I am also don't know the meaning,but GroupOrbits[SymmetricGroup[3], {-0.63 - 1.1 I, 1.26, -0.63 + 1.1 I}, Conjugate[#] &] without error message. Apr 22, 2022 at 10:12
• perhaps GroupOrbits[SymmetricGroup[3], {{-0.63 - 1.1 I, 1.26, -0.63 + 1.1 I}}, Permute[Conjugate@#, #2] &]?
– kglr
Apr 22, 2022 at 10:31
• SymmetricGroup[3] // GroupElements results in {Cycles[{}], Cycles[{{2, 3}}], Cycles[{{1, 2}}], Cycles[{{1, 2, 3}}], Cycles[{{1, 3, 2}}], Cycles[{{1, 3}}]} so {-0.63-1.1 I,1.26,-0.63+1.1 I} is unclear to me. Apr 22, 2022 at 11:14
• Also I don't find the Conjugate option in the documentation to GroupOrbits. Apr 22, 2022 at 11:29

This is a separate answer looking at subgroups:

The roots and the rules to allow manipulation of permutations:

r = Power[2, 1/3] {1, Exp[2 Pi I/3], Exp[4 Pi I/3]} // ComplexExpand


The subgroups generated be e,r,f, r f, r^2f:

sge = {{1, 2, 3}}
rg = {# &, Exp[2 Pi I/3] # &, Exp[4 Pi I/3] # &};
sgr = Union[(Table[rg[[j]] /@ r, {j, 3}] // ComplexExpand) /. rules]
fg = {# &, Conjugate@# &};
sf = Union[(Table[fg[[j]] /@ r, {j, 2}] // ComplexExpand) /. rules]
rfg = {# &, Composition[Exp[2 Pi I/3] # &, Conjugate[#] &],
Composition[Exp[2 Pi I/3] # &, Conjugate[#] &, Exp[2 Pi I/3] # &,
Conjugate[#] &]};
sgrf = Union[(Table[rfg[[j]] /@ r, {j, 2}] // ComplexExpand) /. rules]
r2f = {# &, Composition[Exp[4 Pi I/3] # &, Conjugate[#] &],
Composition[Exp[4 Pi I/3] # &, Conjugate[#] &, Exp[4 Pi I/3] # &,
Conjugate[#] &]};
sgr2f = Union[(Table[r2f[[j]] /@ r, {j, 3}] // ComplexExpand) /.
rules]


Converting subgroups to elements of $$S_3$$:

subgroups =
Sort /@ Table[
PermutationCycles /@ j, {j, {sge, sgr, sf, sgrf, sgr2f}}]


Labeling the subgroups:

  sglab = Thread[
subgroups -> {"<e>", "<r>",    "<f>", "<rf>",
"<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>"}]


Deriving relations between subgroups by conjugation:

s3 = GroupElements[SymmetricGroup[3]]
func[x_, y_] := PermutationProduct[x, #, InversePermutation[x]] & /@ y;
res = TableForm[
grp=Transpose[
Map[Sort, (Table[Union@func[#, j] & /@ s3, {j, subgroups}]), {2}] /.
sglab], TableHeadings -> {Row[{"\[Tau](", #, ")"}] & /@ {"e", "f",
"\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f", "r",
"\!$$\*SuperscriptBox[\(r$$, $$2$$]\)", "rf"}, None}]


This is consistent with the hyperlinked relations. The order is different but can be re-ordered as desired

To produce the graph:

w = PermutationCycles /@ (grp[[{1, 2, 4}]] /.
"<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>"} -> Range[5]])

gph = {Range[5],
DeleteCases[
DirectedEdge[Range[5], Permute[Range[5], #]]] & /@
w[[2 ;; 3]])], DirectedEdge[a_, a_]]} /.
Thread[Range[5] -> {"<e>", "<r>", "<f>", "<rf>",
"<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>"}];
Graph[##, VertexLabels -> "Name",
EdgeStyle -> {"<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>" \
\[DirectedEdge] "<rf>" -> Red, "<rf>" \[DirectedEdge] "<f>" -> Red,
"<f>" \[DirectedEdge] "<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>" ->
Red}, EdgeLabels -> {"<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>" \
\[DirectedEdge] "<rf>" -> "r", "<rf>" \[DirectedEdge] "<f>" -> "r",
"<f>" \[DirectedEdge] "<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>" ->
"r", "<rf>" \[DirectedEdge]
"<\!$$\*SuperscriptBox[\(r$$, $$2$$]\)f>" -> "f"}] & @@ gph


• What is your variable grp?
– yode
Apr 25, 2022 at 13:57
• grp was the the t(e), t(r) and t(f). I apologise for omission and will correct when I get time. There other formatting errors I will correct. w just converts to cycles. I note that this shows <e> and <r> = A3 are normal subgroups of S3. Further, the chain <e> - <r>-S3 is such that S3/<r> is Abelian and <r>/<e> is Abelian. Hence S3 is a solvable group. I will correct my errors omission/ formatting when I have access to computer. It is 0100 in my Timezone. Apr 25, 2022 at 14:58
• I have made corrections. Apr 26, 2022 at 1:46

This is an extended comment. I post this for insight. r and f generate the group. Note r is order 3 and f is order 2 and the group generated is of order 6 (in fact $$S_3$$). This is not unexpected as rotations (cyclically permute roots) and f (complex conjugation) is a transposition of roots. There 2 generators generate all the permutations of the roots.

    t = Composition @@@
Tuples[{{# &, Exp[2 Pi I/3] # &, Exp[4 Pi I/3] # &}, {# &,
Conjugate[#] &}}];
r = Power[2, 1/3] {1, Exp[2 Pi I/3], Exp[4 Pi I/3]} // ComplexExpand


t are the group elements. r are the roots of $$x^3-2$$.

Group actions on roots:

a = Table[t[[j]] /@ r, {j, 6}] // ComplexExpand


Translating to permutations:

rules = Thread[r -> Range[3]];
p = a /. rules


yields: {{1, 2, 3}, {1, 3, 2}, {2, 3, 1}, {2, 1, 3}, {3, 1, 2}, {3, 2, 1}}

The cycles:

cyc = PermutationCycles /@ p


yields: {Cycles[{}], Cycles[{{2, 3}}], Cycles[{{1, 2, 3}}], Cycles[{{1, 2}}], Cycles[{{1, 3, 2}}], Cycles[{{1, 3}}]}

Note:

Sort@GroupElements[SymmetricGroup[3]] === Sort@cyc


yields True confirming the group generated by r and f is $$S_3$$

Note r and f do not commute. However, as expected yield same group:

u = Composition @@@
Tuples[{{# &, Conjugate[#] &}, {# &, Exp[2 Pi I/3] # &,
Exp[4 Pi I/3] # &}}];
b = Table[t[[j]] /@ r, {j, 6}] // ComplexExpand;
q = b /. rules;
cycq = PermutationCycles /@ q
Sort[cycq] === Sort[GroupElements@SymmetricGroup[3]]


yields: True.

I do not see why you would use the 3. parameter for the symmetric group S3.

Every group is isomorph to some permutation group. Therefore MMA deals with permutations of elements: 1,2,... You may always map the result back to the original group. By e.g.

rules=Thread[{1,2,3}->{-0.63 - 1.1 I, 1.26, -0.63 + 1.1 I}]


Now, e.g. the orbit of element 1 is:

GroupOrbits[SymmetricGroup[3], {1}]
(* {{1, 2, 3}} *)


Or with the original elements:

GroupOrbits[SymmetricGroup[3], {1}] /. rules
(* {{-0.63 - 1.1 I, 1.26, -0.63 + 1.1 I}} *)

• Maybe you are right, but what I can't understand is that in your answer $r_1$,$r_2$ and $r_3$ are all equivalents, but in fact $r_2$ and $r_3$ have an additional relationship as the picture. If this relationship cannot be gotten with GroupOrbits, what function of mma would this require?
– yode
Apr 22, 2022 at 11:36
• We are dealing here with a group. That is a set and a 2-ary operation. In your case elements 1,2,3 and permutations. Your operation 2 <-> 3 is a permutation(Cycle[{{2,3}}] and is therefore already contained in the group S3. Apr 22, 2022 at 11:57
• Hi, I think the red arrow(from $r_2$ to $r_3$) is permutation(Cycle[{{2,3}}] as you said, but the blue arrow in the picture is not. And this relationship(conjugacy) doesn't seem to manifest itself on the orbit.
– yode
Apr 22, 2022 at 16:31
• No, you misinterprete "Cycle". Cycle[{{2,3}}] means the exchange of 2 and 3, that is it is the BLUE arrow. The red arrows are: Cycle[{{1,2,3}}] Apr 22, 2022 at 18:17
• You are right. But if we just care about their orbit, then just the red arrow is enough, there is no need for that extra blue arrow. So the orbits don't seem to provide us with all the information. And I would like to use MMA to show all the relationships in the diagram, but I don't know what to do with it. The GroupOrbits used in my post don't look like they meet my requirements (after your analysis)
– yode
Apr 23, 2022 at 2:51
subgroups = Most[DeleteDuplicatesBy[
PermutationGroup /@ Subsets[GroupElements[SymmetricGroup[3]]], GroupElements]];
gens = GroupGenerators[SymmetricGroup[3]];
RelationGraph[AnyTrue[Function[g, PermutationReplace[#, g]] /@ gens,
Function[e, (e == #2) && (#2 =!= #)]] &, subgroups]


sortsols = Permute[sols, FindPermutation[{1, 2, 3}, {2, 3, 1}]];
Row[Show[
ComplexListPlot[MapIndexed[Callout[#1, First[#2]] &, sortsols],
PlotStyle -> PointSize[0.05]],
GraphPlot[
DirectedEdge @@@ Transpose[{Range[3], PermutationList[#, 3]}],
VertexCoordinates ->
MapIndexed[First[#2] -> # &, ReIm /@ sortsols],
EdgeStyle -> Red, SelfLoopStyle -> None],
AspectRatio -> Automatic, ImageSize -> 150, PlotRange -> All] & /@
GroupElements[SymmetricGroup[3]], Frame -> All]