In[]:=
Graph[Rule@@@#,GraphLayout"SpringElectricalEmbedding",ImageSizeTiny,VertexStyleResourceFunction["WolframPhysicsProjectStyleData"]["SpatialGraph","VertexStyle"],EdgeStyleResourceFunction["WolframPhysicsProjectStyleData"]["SpatialGraph","EdgeLineStyle"]]&/@ResourceFunction["WolframModel"][{{x,y},{y,z}}{{w,x},{w,y},{x,y},{y,z}},{{1,2},{2,1}},9,"StatesList"]
Out[]=
In[]:=
hgraph[max_]:=Graph[UndirectedEdge@@@Flatten[Table[Sort/@(Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]/Pi),{n,1,max+1}],1]]
In[]:=
hgraph[6]
Out[]=
In[]:=
GraphPlot3D[ResourceFunction["HypergraphToGraph"]@ResourceFunction["WolframModel"][{{x,y},{y,z}}{{w,x},{w,y},{x,y},{y,z}},{{0,0},{0,0}},10,"FinalState"]]
Out[]=
In[]:=
ResourceFunction["GraphReconstructedSurface"]@ResourceFunction["WolframModel"][{{x,y},{y,z}}{{w,x},{w,y},{x,y},{y,z}},{{0,0},{0,0}},10,"FinalState"]
Out[]=
In[]:=
ResourceFunction["GraphReconstructedSurface"][ResourceFunction["WolframModel"][{{x,y},{y,z}}{{w,x},{w,y},{x,y},{y,z}},{{0,0},{0,0}},8,"FinalState"],VertexSize.01]
Out[]=
In[]:=
tgraph[max_]:=Module[{inf,len,triangles,triedge,tricoord2,argPoint},argPoint[arg_]:={Cos[arg],Sin[arg]};inf=Flatten[Table[Sort/@(Partition[Table[2kPi/(2^n),{k,0,2^n-1}],2,1,1]/Pi),{n,1,max+1}],1];triangles=SortBy[First/@#&/@FindCycle[Graph[UndirectedEdge@@@Union[inf]],{3},All],Max[Denominator/@#]&];len=Length[triangles];triedge=Select[Subsets[Range[len],{2}],Length[Intersection@@triangles[[#]]]2&];tricoord2=Table[(Log[2,Max[Denominator/@triangles[[k]]]]+2)Reverse[N[Mean[argPoint[Pi#]&/@triangles[[k]]]]],{k,1,len}];Graph[Range[len],triedge,VertexCoordinatesThread[Range[len]tricoord2]]]
In[]:=
tgraph[5]
Out[]=
In[]:=
hgraph[5]
Out[]=
In[]:=
Show[GraphPlot/@{hgraph[5],tgraph[5]}]
Out[]=