Wolfram
Mathematica
8의 신기능: 그래프 및 네트워크 분석
◄
이전
|
다음
►
응용 분야
동형사상 찾기
두 그래프의 동형사상을 찾아 봅니다.
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]=