Hypergraph represented as ordinary directed graph
Hypergraph represented as ordinary directed graph
In[]:=
edges={{1,2,2},{3,1,4},{3,5,1},{6,5,4},{2,7,6},{8,7,4}};
Implementation
In[]:=
hypergraphToGraph[edges_]:=Catenate[Partition[#,2,1]~Join~{{#〚1〛,#〚-1〛}}&/@MapIndexed[Function[k,e[#2〚1〛,k]]/@Range[#]&,Length/@edges]]~Join~Catenate[MapIndexed[{e@@#2,#}&,edges,{2}]]
In[]:=
WolframModelPlot[hypergraphToGraph[{{1,2,3},{3,4,5},{5,6,1}}],VertexLabelsAutomatic]
Out[]=
In[]:=
WolframModelPlot[{{1,2,2},{3,1,4},{3,5,1},{6,5,4},{2,7,6},{8,7,4}}]
Out[]=
In[]:=
hypergraphToGraph[{{1,2,2},{3,1,4},{3,5,1},{6,5,4},{2,7,6},{8,7,4}}]//WolframModelPlot
Out[]=
Possibly: translation of rules
Possibly: translation of rules
{{x,y,z},{z,u,v}}{{w,z,v},{z,x,w},{w,y,u}}
In[]:=
RulePlot[WolframModel[{{x,y,z},{z,u,v}}{{w,z,v},{z,x,w},{w,y,u}}]]
Out[]=
In[]:=
RulePlot[WolframModel[hypergraphToGraph/@({{x,y,z},{z,u,v}}{{w,z,v},{z,x,w},{w,y,u}})]]
Out[]=
In[]:=
WolframModel[({{x,y,z},{z,u,v}}{{w,z,v},{z,x,w},{w,y,u}}),{{0,0,0},{0,0,0}},15,"FinalStatePlot"]
Out[]=
In[]:=
WolframModel[hypergraphToGraph/@({{x,y,z},{z,u,v}}{{w,z,v},{z,x,w},{w,y,u}}),hypergraphToGraph[{{0,0,0},{0,0,0}}],15,"FinalStatePlot"]
Out[]=
Sierpinski
Sierpinski
In[]:=
RulePlot@WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{6,5},{4,7},{8,7},{6,9},{8,9},{4,1},{6,2},{8,3}}]
Out[]=
In[]:=
Row[PlanarGraph[#,EdgeStyleDirective[Hue[0.63,0.7,0.5],Opacity[0.7]],VertexStyleDirective[Hue[0.63,0.26,0.89],EdgeForm[Directive[Hue[0.63,0.7,0.33],Opacity[0.95]]]],VertexSize0]&/@Apply[UndirectedEdge,WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{6,5},{4,7},{8,7},{6,9},{8,9},{4,1},{6,2},{8,3}},{{0,1},{2,1},{0,3},{4,3},{0,5},{6,5},{2,7},{4,7},{2,8},{6,8},{4,9},{6,9}},3,"StatesList"],{2}],Spacer[10]]
Out[]=
In[]:=
Row[PlanarGraph[#,EdgeStyleBlack,VertexSize0]&/@Apply[UndirectedEdge,(WolframModel[{{0,1},{2,1}}{{0,2}},#,"FinalState"]&)/@WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{6,5},{4,7},{8,7},{6,9},{8,9},{4,1},{6,2},{8,3}},{{0,1},{2,1},{0,3},{4,3},{0,5},{6,5},{2,7},{4,7},{2,8},{6,8},{4,9},{6,9}},3,"StatesList"],{2}],Spacer[10]]
Out[]=
Nonoverlap graphs
Nonoverlap graphs
In[]:=
MyShowGraph[adjacency_,coordinates_,___]:=SimpleGraph[Catenate[MapIndexed[Thread[#2[[1]]#]&,adjacency]],VertexCoordinatesThread[Range[Length[coordinates]]coordinates]]
One Hair Graphs to 8 nodes
One Hair Graphs to 8 nodes
In[]:=
hone1=MyShowGraph[{{2,5,3},{1},{1,6,4},{3,5,6},{6,1,4},{4,5,3}},{{5,-2},{5,-1},{4,-3},{5,-4},{6,-3},{5,-3}},{3,-1},{7,-5}];
Two Hair Graphs to 10 nodes
Two Hair Graphs to 10 nodes
Three Hair Graphs to 12 nodes
Three Hair Graphs to 12 nodes
Graphics
Graphics
FIX: assume a *definite ordering
Trivalent
Trivalent
Asymmetric Rule
Asymmetric Rule