New in Wolfram
Mathematica
8: Graph & Network Analysis
◄
previous
|
next
►
Application Areas
Find an Isomorphism
Find an isomorphism that maps two graphs.
In[1]:=
X
style = {VertexLabels -> "Name", ImagePadding -> 10, VertexSize -> 0.6, ImageSize -> 200, VertexStyle -> EdgeForm[]};
In[2]:=
X
g = PetersenGraph[4, 1, style];
In[3]:=
X
v1 = {"a", "b", "c", "d"}; v2 = {"e", "f", "g", "h"};
In[4]:=
X
edge = Table[(v1[[i]] \[UndirectedEdge] #) & /@ Delete[v2, 5 - i], {i, 4}] // Flatten;
In[5]:=
X
h = Graph[Join[v1, v2], edge, style, AbsoluteOptions[CompleteGraph[{4, 4}], VertexCoordinates]];
In[6]:=
X
map = FindGraphIsomorphism[g, h];
In[7]:=
X
styname[name_] := Style[name, 14, Bold, White, FontFamily -> "Verdana"];
In[8]:=
X
Highlightgraph[g_, v_] := HighlightGraph[g, Table[Style[Labeled[v[[i]], styname[v[[i]]], Center], ColorData["Rainbow"][i/VertexCount[g]]], {i, VertexCount[g]}]];
In[9]:=
X
info = {Highlightgraph[g, First /@ map], Spacer[20], Style[Column[map], 16, FontFamily -> "Verdana"], Spacer[20], Highlightgraph[h, Last /@ map]};
In[10]:=
X
Row[info, Frame -> All, FrameStyle -> LightGray]
Out[10]=