4
$\begingroup$

Given

g = Graph[{1 -> 2, 2 -> 3, 3 -> 1, 4 -> 1, 1 -> 5, 5 -> 4}, VertexLabels -> "Name"] 
GraphAutomorphismGroup[g]

outputs

PermutationGroup[{Cycles[{{2, 5}, {3, 4}}]}]

which I understand as changing 2 -> 5, and 3 -> 4 will give an automorphic graph. This is true when tested:

g2 = Graph[{1 -> 5, 5 -> 4, 4 -> 1, 3 -> 1, 1 -> 2, 2 -> 3}, VertexLabels -> "Name"]
IsomorphicGraphQ[g, g2]

True

With any given graph, I want to explicitly generate all the automorphic graphs (cause I want to compare adjacency matrices), can I use PermutationGroup and Cycles to do this or it's easier if I just dump these parts of the expression and use Replace?

$\endgroup$
2
$\begingroup$
ClearAll[f]
f = With[{g = #,  vl = VertexList[#], 
         pvl = Permute[ VertexList[#], GraphAutomorphismGroup[#]]}, 
         SetProperty[VertexReplace[g,Thread[vl->#]], 
          {VertexLabels -> "Name", ImageSize -> 300}]& /@ pvl]&;

g = Graph[{1 -> 2, 2 -> 3, 3 -> 1, 4 -> 1, 1 -> 5, 5 -> 4}, VertexLabels -> "Name"] 

Mathematica graphics

Row[f @ g]

enter image description here

Row[f @ CycleGraph[5, VertexLabels->"Name", DirectedEdges->True]]

Mathematica graphics

And @@ (IsomorphicGraphQ[g2, #] & /@ f[g2])

True

g3= PetersenGraph[5,2];
And@@(IsomorphicGraphQ[g3,#]&/@f[g3])

True

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.