​
In[]:=
Attributes[u]={Flat,Orderless};Attributes[v]=Orderless
Out[]=
Orderless
In[]:=
NetStep[rule_,net_]:=Block[{new},net/.rule/.new[n_]n+Apply[Max,Map[First,net]]]
In[]:=
GraphData["TetrahedralGraph"]
Out[]=
In[]:=
ToGraph[expr_]:=UndirectedGraph[Catenate[Thread/@(expr/.{uList,vList})]]
In[]:=
ToGraph[u[1v[2,3,4],2v[1,3,4],3v[1,2,4],4v[1,2,3]]]
Out[]=
In[]:=
IsomorphicGraphQ
,

Out[]=
True
In[]:=
ssirule=u[i1_v[i2_,i3_,i4_]]u[new[1]v[i2,new[3],new[2]],new[2]v[3,new[3],new[1]],new[3]v[4,new[1],new[2]]]
Out[]=
u[i1_v[i2_,i3_,i4_]]u[new[1]v[i2,new[3],new[2]],new[2]v[3,new[3],new[1]],new[3]v[4,new[1],new[2]]]
In[]:=
ToGraph[NetStep[ssirule,u[1v[2,3,4]]]]
Out[]=
In[]:=
ToGraph/@NestList[NetStep[ssirule,#]&,u[1v[2,3,4],2v[1,3,4],3v[1,2,4],4v[1,2,3]],5]
Out[]=
In[]:=
Graph3D/@%
Out[]=
In[]:=
HypergraphPlot/@WolframModel[{{1,2,3}}{{1,4,6},{2,5,4},{3,6,5}},{{0,0,0}},5,"StatesList"]
Out[]=
In[]:=
ss3=UndirectedGraph[HypergraphToGraph[WolframModel[{{1,2,3}}{{1,4,6},{2,5,4},{3,6,5}},{{0,0,0}},3,"FinalState"]]]
Out[]=
OSZAR »