Using code from ColoredNetworks-06

In[]:=
selected=rules[[{45,18,21,17,31}]]
Out[]=
In[]:=
all=ParallelMapMonitored[TimeConstrained[WolframModel[coloredRuleToHypergraph[#],coloredSpecToHypergraph[{{4,5,6},{1,2,3}}],4]["FinalState"],5]#&,selected/.OrderedNet[{_,x_}]x];
In[]:=
ParallelMapMonitored[OrderedGraphModelPlot[hypergraphToColoredSpec[First[#]],VertexShapeFunction"Circle"]Last[#]&,all]
Out[]=
In[]:=
coloredSpecToHypergraph[{{4,5,6},{1,2,3}}]
Out[]=
{{1,2,3},{4,5,6},{1,4},{2,5},{3,6},{4,1},{5,2},{6,3}}
In[]:=
inits=Get["/Users/sw/Dropbox/Physics/SW2004Material/Data/AllOrderedNetsTo4.m"];
In[]:=
inits[[2]][[1]]
Out[]=
OrderedNet[{{1,1},{{4,5,6},{1,2,3}}}]
In[]:=
coloredRuleToHypergraph/@(selected/.OrderedNet[{_,x_}]x)
Out[]=

TED rules

In[]:=
Take[(rules[[Union[Range[50],{17,18,19,20,21,22,31,32,33,34,45,46,113,114,115,116,117,118,123,124,125,126,143,144,197,198,199,200,201,202,215,216,217,218,231,232}]]]/.(OrderedNet[{_,x_}]x)),5]
Out[]=
In[]:=
OrderedGraphModelPlot[#,Automatic,{{VertexSize.4},{VertexSize.5}}]&/@Take[(rules[[Union[Range[50],{17,18,19,20,21,22,31,32,33,34,45,46,113,114,115,116,117,118,123,124,125,126,143,144,197,198,199,200,201,202,215,216,217,218,231,232}]]]/.(OrderedNet[{_,x_}]x)),5]
Out[]=
In[]:=
coloredRuleToHypergraph/@Take[(rules[[Union[Range[50],{17,18,19,20,21,22,31,32,33,34,45,46,113,114,115,116,117,118,123,124,125,126,143,144,197,198,199,200,201,202,215,216,217,218,231,232}]]]/.(OrderedNet[{_,x_}]x)),5]
Out[]=
In[]:=
RulePlot[WolframModel[#]]&/@%
Out[]=
In[]:=
AllOrderedNetsTo4[[2]]
Out[]=
NetPlot[#,ImageSize45]&/@Select[AllOrderedNetsTo4[[2]],HairNumber[#]0&]
IconGP[#,ImageSize45]&/@Select[AllOrderedNetsTo4[[2]],HairNumber[#]0&]
In[]:=
IconGP[x:_[{_,ls_}],opts___]/;OptionQ[{opts}]:=IconGP[x,IconObject,opts]
In[]:=
IconGP[_[{_,ls_}],nodefunction_,opts___]:=Module[{gp=GraphPlot[GraphRules0[ls]],pts},​​pts=gp[[1,1,1]][[Ordering[VertexList[GraphRules0[ls]]]]];​​Graphics[{gp[[1]],MapIndexed[Function[{var,ind},​​nodefunction[var,​​If[IntegerQ[#],{pts[[Quotient[2+#,3]]],#,ind[[1]]},{pts[[Length[ls]+First[#]]],#}]&/@Extract[ls,ind]]],Take[pts,Length[ls]]]},Sequence@@Rest[gp],opts]]
In[]:=
GraphRules0[ls_]:=Join[Union[Select[#,SameQ@@#&]],Select[Flatten[MapIndexed[#2[[1]]Quotient[#+2,3]&,ls/.{h[n_]3(n+Length[ls])},{2}]],#[[1]]<#[[2]]&]]&[Flatten[MapIndexed[#2[[1]]Quotient[#+2,3]&,ls/.{h[n_]3(n+Length[ls])},{2}]]]
In[]:=
Take[rules[[Union[Range[50],{17,18,19,20,21,22,31,32,33,34,45,46,113,114,115,116,117,118,123,124,125,126,143,144,197,198,199,200,201,202,215,216,217,218,231,232}]]],5]
Out[]=
In[]:=
Map[IconGP,%,{2}]
Part
:Part 3 of {1.22474,1.63299} does not exist.
Part
:Part 3 of {1.22474,1.63299} does not exist.
Part
:Part 3 of {1.22474,1.63299}〚{1,2,3,4,5,6}〛 does not exist.
General
:Further output of Part::partw will be suppressed during this calculation.
Part
:The expression IconObject[{1,2,3,4,5,6},{{{1.22474,1.63299},1,2},{{1.22474,1.63299}〚{1,2,3,4,5,6}〛〚5〛,h[3]},{{1.22474,1.63299}〚{1,2,3,4,5,6}〛〚6〛,h[4]}}] cannot be used as a part specification.