Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I try to compute the Automorphisms of graphs with multiple edges from its AdjacencyMatrix but failed. The following code shows how to compute the Automorphisms of graphs without multiple edges:

Block[{$ContextPath}, Needs["Combinatorica`"];
Needs["GraphUtilities`"]]
m = ({
{0, 1, 1, 1},
{1, 0, 1, 1},
{1, 1, 0, 1},
{1, 1, 1, 0}
});
g = AdjacencyGraph[m];
Combinatorica`Automorphisms@GraphUtilities`ToCombinatoricaGraph[g]//Lenght (*24*)

As I have tried, AdjacencyGraph, IncidenceGraph will fail to convert a matrix into a graph. And

Graph[{1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 2}]

will fail also. But if I plot the graph as a figure directly Automorphisms will fail at that figure of graph. Other software will do this work, for example Sage.

So, how to compute the Automorphisms of graphs with multiple edges in Mathematica?

share|improve this question

1 Answer 1

up vote 4 down vote accepted

I hope the following is helpful:

Firstly, consider this example:

gr = System`Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 3 <-> 5}];
sysm = System`AdjacencyMatrix[gr];
com = Combinatorica`FromAdjacencyMatrix[Normal@sysm];
aut = Combinatorica`Automorphisms[com];
ex = System`Graph[EdgeList[gr], 
    VertexLabels -> Table[j -> Placed[#[[j]], Center], {j, 5}], 
    VertexSize -> 0.4, VertexLabelStyle -> Directive[20, White]] & /@ 
  aut

enter image description here

Automating (this is not pretty but a start):

fun[mat_] := Module[{sg, sgel, cg, au},
  Needs["Combinatorica`"];
  sg = System`AdjacencyGraph[mat];
  sgel = EdgeList[sg];
  cg = Combinatorica`FromAdjacencyMatrix[mat];
  au = Combinatorica`Automorphisms[cg];
  System`Graph[sgel, 
     VertexLabels -> 
      Table[j -> Placed[#[[j]], Center], {j, VertexCount@sg}], 
     VertexSize -> 0.4, VertexLabelStyle -> Directive[12, White]] & /@
    au]

Applying to your complete graph (which necessarily has 4!=24 automorphisms) and visualizing:

m = ({{0, 1, 1, 1}, {1, 0, 1, 1}, {1, 1, 0, 1}, {1, 1, 1, 0}});
gg = GraphicsGrid[Partition[fun[m], 6], Frame -> All, 
  ImageSize -> 500]

enter image description here

share|improve this answer
1  
Thanks so much! Your answer is very elegant and helpful but it is not the right one. The question is about graphs with multiple edges. –  Eden Harder May 10 at 7:21
    
As I find, the code in your answer does not work for the matrix {{0, 1, 0, 0}, {1, 0, 1, 0}, {0, 1, 0, 1}, {0, 0, 1, 0}}. It is strange. –  Eden Harder May 10 at 7:35
    
@EdenHarder sorry will look at when I get a chance –  ubpdqn May 10 at 9:26
    
@EdenHarder not sure why fails for this class of graphs –  ubpdqn May 10 at 11:09

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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