Ordered Network Model Graphics
Ordered Network Model Graphics
Model Translation Code
Model Translation Code
In[]:=
coloredSpecPattern={{___}...};
In[]:=
coloredSpecToHypergraph[spec:coloredSpecPattern]:=TakeList[Range[Length[Catenate[spec]]],Length/@spec]~Join~Select[FreeQ[h]]@Transpose[{Range[Length[Catenate[spec]]],Catenate[spec]}]
In[]:=
coloredRuleToHypergraph[in:coloredSpecPatternout:coloredSpecPattern]:=Module[{hairPositions,hairRules,outIndexToHair,hairToInIndex,outToInMapping},hairPositions=Position[Catenate[#],_h,{1}]〚All,1〛&/@{in,out};hairRules=Thread[Catenate[{in,out}〚#〛]〚hairPositions〚#〛〛hairPositions〚#〛]&/@{1,2};outIndexToHair=Association[Reverse/@hairRules〚2〛];hairToInIndex=Association[hairRules〚1〛];outToInMapping=Association[(#+Length[Catenate[in]])hairToInIndex[outIndexToHair[#]]&/@Keys[outIndexToHair]];coloredSpecToHypergraph[in](coloredSpecToHypergraph[out]+Length[Catenate[in]]/.outToInMapping)]
In[]:=
hypergraphToColoredSpec[edges_,hairVertices_:Automatic]:=Module[{threeEdges,verticesToIndices,twoEdges,indexRelations,hairlessSpec,hairPositions,hairs},threeEdges=Cases[edges,{_,_,_},{1}];verticesToIndices=Association[Thread[Catenate[threeEdges]Range[Length[Catenate[threeEdges]]]]];twoEdges=Cases[edges,{_,_},{1}];indexRelations=Select[OrderedQ]@Map[verticesToIndices,twoEdges,{2}];hairlessSpec=Partition[Permute[Range[Length[Catenate[threeEdges]]],Cycles[indexRelations]],3];hairPositions=If[hairVertices===Automatic,Position[Partition[Range[Length[Catenate[threeEdges]]],3]-hairlessSpec,0],Position[threeEdges,#]〚1〛&/@hairVertices];hairs=h/@Range[Length[hairPositions]];ReplacePart[hairlessSpec,Thread[hairPositionshairs]]]
In[]:=
hypergraphRuleToColored[in_out_]:=With[{hairVertices=Intersection[Catenate[in],Catenate[out]]},Rule@@(hypergraphToColoredSpec[#,hairVertices]&/@{in,out})]
Pictures
Pictures
In[]:=
OrderedGraphModelPlot[{{h[1],h[2],6},{h[3],h[4],3}}{{6,h[1],h[2]},{8,7,1},{5,4,10},{9,h[3],h[4]}},{{0.1,0.1},{0.3,0.3}},{{VertexSize0.48,ImageSize125},{VertexSize0.6,ImageSize125}}]
Out[]=
In[]:=
MapThread[OrderedGraphModelPlot[#1,VertexSize#2,ImageSizeTiny]&,{hypergraphToColoredSpec/@WolframModel[coloredRuleToHypergraph[{{h[1],h[2],6},{h[3],h[4],3}}{{6,h[1],h[2]},{8,7,1},{5,4,10},{9,h[3],h[4]}}],coloredSpecToHypergraph[{{4,5,6},{1,2,3}}],10]["StatesList"],Table[0.1,{k,11}]}]
0.85
k
Out[]=
In[]:=
OrderedGraphModelPlot[hypergraphRuleToColored[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}}],Automatic,{{VertexSize0.3,ImageSize125},{VertexSize0.36,ImageSize125}}]
Out[]=
In[]:=
OrderedGraphModelPlot[hypergraphToColoredSpec[WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}},coloredSpecToHypergraph[{{4,5,6},{1,2,3}}],9]["FinalState"]]]
Out[]=
In[]:=
OrderedGraphModelPlot[hypergraphRuleToColored[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1y,p2y},{p2y,p1y}}{{p3r,p1r,p3g},{p4r,p1g,p4g},{p5r,p2r,p5g},{p6r,p2g,p6g},{p3r,p6r},{p3g,p4g},{p4r,p5r},{p4g,p3g},{p5r,p4r},{p5g,p6g},{p6r,p3r},{p6g,p5g}}],Automatic,{{VertexSize0.3,ImageSize125},{VertexSize0.36,ImageSize125}}]
Out[]=
In[]:=
OrderedGraphModelPlot[hypergraphToColoredSpec[WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1y,p2y},{p2y,p1y}}{{p3r,p1r,p3g},{p4r,p1g,p4g},{p5r,p2r,p5g},{p6r,p2g,p6g},{p3r,p6r},{p3g,p4g},{p4r,p5r},{p4g,p3g},{p5r,p4r},{p5g,p6g},{p6r,p3r},{p6g,p5g}},coloredSpecToHypergraph[{{4,5,6},{1,2,3}}],9]["FinalState"]]]
Out[]=
In[]:=
OrderedGraphModelPlot[hypergraphRuleToColored[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p5y},{p3g,p6g},{p4y,p6y},{p4g,p5g},{p5y,p3y},{p5g,p4g},{p6y,p4y},{p6g,p3g}}],Automatic,{{VertexSize0.6,ImageSize125},{VertexSize0.36,ImageSize125}}]
Out[]=
In[]:=
OrderedGraphModelPlot[hypergraphToColoredSpec[WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p5y},{p3g,p6g},{p4y,p6y},{p4g,p5g},{p5y,p3y},{p5g,p4g},{p6y,p4y},{p6g,p3g}},coloredSpecToHypergraph[{{4,5,6},{1,2,3}}],9]["FinalState"]]]