MultiwaySystem[{"AB""BA","BA""AB"},StringTuples["AB",6],10,"StatesGraph"]
In[]:=
Out[]=
Groupify[{gens:{__String},rels_}]:=Module[{igens=ToLowerCase[gens]},{Flatten@{gens,igens},Flatten[{rels,ToLowerCase[#2]ToLowerCase[#1]&@@@rels,Table[{gens[[i]]<>igens[[i]]"",igens[[i]]<>gens[[i]]""},{i,Length[gens]}]}]}]
In[]:=
Groupify
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AAA"""}},{""},6],GraphLayout"SpringElectricalEmbedding"],Center]
In[]:=
Out[]=
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AA"""}},{""},6],GraphLayout"SpringElectricalEmbedding"],Center,VertexLabelsAutomatic]
In[]:=
Out[]=
GraphElementData["EdgeShapeFunction"]
In[]:=
{Arrow,BoxLine,CarvedArcArrow,CarvedArrow,DashedLine,DiamondLine,DotLine,DottedLine,FilledArcArrow,FilledArrow,HalfFilledArrow,HalfFilledDoubleArrow,HalfUnfilledArrow,HalfUnfilledDoubleArrow,Line,ShortCarvedArcArrow,ShortCarvedArrow,ShortFilledArcArrow,ShortFilledArrow,ShortUnfilledArcArrow,ShortUnfilledArrow,UnfilledArcArrow,UnfilledArrow}
Out[]=
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AA"""}},{""},4],GraphLayout"SpringElectricalEmbedding"],Center,VertexLabelsAutomatic,EdgeLabels(DirectedEdge[x_,y_]If[StringLength[y]0,"",StringTake[y,-1]])]
In[]:=
Out[]=
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AB""BA","BA""AB"}},{""},6],GraphLayout"SpringElectricalEmbedding"],Center,VertexLabelsAutomatic]
In[]:=
Out[]=
Graph[CayleyNestGraph[{{"A","B"},{"AB""BA","BA""AB"}},{""},6],GraphLayout"SpringElectricalEmbedding",VertexLabelsAutomatic,EdgeLabels(DirectedEdge[x_,y_]If[StringLength[y]0,"",StringTake[y,-1]])]
In[]:=
Out[]=
Groupify[{{"A","B"},{"AB""BA","BA""AB"}}]
In[]:=
{{A,B,a,b},{ABBA,BAAB,baab,abba,Aa,aA,Bb,bB}}
Out[]=
NestGraph
Graph[CayleyNestGraph[{{"A","B"},{"AB""BA","BA""AB"}},{""},4,"IncludeEdgeLabels"True],VertexLabelsAutomatic]
In[]:=
Out[]=
UndirectedGraph[%]
In[]:=
Out[]=
Reduction of the tree by the relations is revealed in cycles, which are the edges in the states graph
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AA""A"}},{""},4,"IncludeEdgeLabels"True],GraphLayout"SpringElectricalEmbedding"],Center,VertexLabelsAutomatic]
In[]:=
Out[]=
MultiwaySystem[{"A""AA"},Table[StringRepeat["A",n],{n,0,4}],5,"StatesGraph"]
In[]:=
Out[]=
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AB""A","B""A"}},{""},4,"IncludeEdgeLabels"True],GraphLayout"SpringElectricalEmbedding"],Center,VertexLabelsAutomatic]
In[]:=
Out[]=
TreePlot[Graph[CayleyNestGraph[{{"A","B"},{"AB""A","B""A"}},StringTuples["AB",2],4,"IncludeEdgeLabels"True],GraphLayout"SpringElectricalEmbedding"],Center,VertexLabelsAutomatic]
In[]:=
Out[]=
MultiwaySystem[Reverse/@{"AB""A","B""A"},StringTuples["AB",2],2,"StatesGraph"]
In[]:=
Out[]=
GroupGenerators[PermutationGroup[{Cycles[{{1,5,4}}],Cycles[{{3,4}}]}]]
In[]:=
{Cycles[{{1,5,4}}],Cycles[{{3,4}}]}
Out[]=
GroupElements[PermutationGroup[{Cycles[{{1,5,4}}],Cycles[{{3,4}}]}]]
In[]:=
Out[]=

Cayley graph is more about events than states....

Cayley graph edges just add generators on the right

Cayley graph colors:

colors[n_]:=Charting`padList[{Hue[0.599116,0.480955,0.709798],Hue[0.202127,0.82,0.62],Hue[0.041225144751899624,0.8,0.88],Hue[0.72,0.48,0.701351],Hue[0.0819199,0.867387,0.772079],Hue[0.565259,0.534864,0.782349],Hue[0.105818,0.838710,0.880722],Hue[0.89,0.49,0.647624],Hue[0.170899,1.,0.586483],Hue[0.0284697,0.767759,0.915],Hue[0.621701,0.528444,0.85],Hue[0.02,0.740259,0.77]},n]
CayleyNestGraph[{{"A","B"},Reverse/@{"""AA","AA""BB","BB""ABABAB"}},{""},2,"IncludeEdgeLabels"True]
In[]:=
$Aborted
Out[]=

Multiway graph from group

FiniteGroupData["Icosahedral","DefiningRelations"]
In[]:=
∘2
61

∘3
16

∘5
17
17∘61∘
∘4
17
∘6161∘16∘16∘61∘16
∘2
(16∘16∘17∘17∘17)

∘3
(17∘16∘16)
1
Out[]=
FullForm[%178]
In[]:=
Out[]//FullForm=
FiniteGroupData["Icosahedral","Generators"]
In[]:=
{16,17,61}
Out[]=
FiniteGroupData[{"SymmetricGroup",3},"DefiningRelations"]
In[]:=
2∘23∘32∘3∘2∘3∘2∘31
Out[]=
FiniteGroupData[{"SymmetricGroup",2},"DefiningRelations"]
In[]:=
2∘21
Out[]=
ToMultiwaySystem[rels_]:=Flatten[rels/.(a_b_){ab,ba}]
In[]:=
MultiwaySystem[ToMultiwaySystem["BB"""],{""},4,"StatesGraph"]
In[]:=
Out[]=
FiniteGroupData[{"SymmetricGroup",3},"DefiningRelations"]
In[]:=
2∘23∘32∘3∘2∘3∘2∘31
Out[]=
FullForm[%185]
In[]:=
Equal[SmallCircle[2,2],SmallCircle[3,3],SmallCircle[2,3,2,3,2,3],1]
Out[]//FullForm=
FiniteGroupData["Icosahedral","Generators"]
In[]:=
{16,17,61}
Out[]=
GroupToMW[group_]:=Module[{gens=FiniteGroupData[group,"Generators"],gmap,rels=FiniteGroupData[group,"DefiningRelations"]},gmap=Thread[gensTake[ToUpperCase[Alphabet[]],Length[gens]]];TwoWayRule@@@Partition[SortBy[(rels/.EqualList/.gmap)/.SmallCircleStringJoin/.1"",StringLength],2,1]]
In[]:=
GroupToMW[{"SymmetricGroup",3}]
In[]:=
{AA,AABB,BBABABAB}
Out[]=
GroupToMW[{"SymmetricGroup",4}]
In[]:=
{AA,AAABABAB,ABABABACAC,ACACBB,BBBCBCBC,BCBCBCCACA,CACACC}
Out[]=
MultiwaySystem[ToMultiwaySystem[GroupToMW[{"SymmetricGroup",3}]],{""},3,"StatesGraph"]
In[]:=
Out[]=
CayleyGraph[SymmetricGroup[3]]
In[]:=
Out[]=
MultiwaySystem[ToMultiwaySystem[GroupToMW[{"SymmetricGroup",3}]],{""},4,"StatesGraph"]
In[]:=
Out[]=
MultiwaySystem[ToMultiwaySystem[GroupToMW[{"SymmetricGroup",3}]],{""},6,"StatesGraphStructure"]
In[]:=
Out[]=
Graph[MultiwaySystem[ToMultiwaySystem[GroupToMW[{"SymmetricGroup",3}]],{""},6,"StatesGraphStructure"],GraphLayout"RadialEmbedding"]
In[]:=
Out[]=
ListLinePlot[Table[RaggedMeanAround[Values[GraphNeighborhoodVolumes[MultiwaySystem[ToMultiwaySystem[GroupToMW[{"SymmetricGroup",3}]],{""},t,"StatesGraphStructure"]]]],{t,8}],FrameTrue]
In[]:=
Out[]=
ListLinePlot[%]
In[]:=
Out[]=
CayleyGraph[SymmetricGroup[3]]
In[]:=
Out[]=
CayleyGraph[AlternatingGroup[5]]
In[]:=
Out[]=
FiniteGroupData["Icosahedral","DefiningRelations"]
In[]:=
∘2
61

∘3
16

∘5
17
17∘61∘
∘4
17
∘6161∘16∘16∘61∘16
∘2
(16∘16∘17∘17∘17)

∘3
(17∘16∘16)
1
Out[]=
FullForm[%178]
In[]:=
Out[]//FullForm=
Superscript[Row[List["(",rr:(PatternSequence[_,"∘"]...),")"]],Row[List["∘",n_]]]Table[(rr/."∘"Nothing),n]
Superscript[Row[List["(",rr:(PatternSequence[_,"∘"]...),")"]],Row[List["∘",2]]]
PatternSequence
GroupToMW[group_]:=Module[{gens=FiniteGroupData[group,"Generators"],gmap,rels=FiniteGroupData[group,"DefiningRelations"]},gmap=Thread[gensTake[ToUpperCase[Alphabet[]],Length[gens]]];TwoWayRule@@@Partition[Sort[(rels/.EqualList/.Superscript[Row[List["(",rr:(PatternSequence[_,"∘"]...),")"]],Row[List["∘",n_]]]StringJoin[Flatten[Table[(rr/."∘"Nothing),n]/.SmallCircleList]]/.Superscript[b_,Row[List["∘",n_]]]Table[b,n]/.gmap)//.SmallCircleStringJoin/.1""],2,1]]
In[]:=
GroupToMW["Icosahedral"]
In[]:=
Out[]=
{"(""A""∘""A""∘""B""∘""B""∘""B"")","(""A""∘""A""∘""B""∘""B""∘""B"")"}