In[]:=
WolframRuleTestWSpec[lhslen_Integer,rhslen_Integer,s_]:=Module[{rules=RandomWolframModelRule[{{1,1}}{{rhslen,2}},s],eo,init},While[!BiConnectedRuleQ[rules],rules=RandomWolframModelRule[{{1,1}}{{rhslen,2}},s]];rules=ReplacePart[rules,{1}Table[{0,i},{i,lhslen}]];init=Table[{0,0},lhslen];eo=TimeConstrained[WolframModel[rules,init,<|"MaxVertices"200,"MaxEdges"200,"MaxEvents"5000,"MaxGenerations"100,"MaxVertexDegree"20|>,TimeConstraint5],6];If[eo===$Aborted,Return[$Aborted]];<|"Rule"rules,"Init"init,"Sizes"Length/@Most[eo["StatesList"]],"FinalState"eo[-2],"EvolutionObject"eo|>]
In[]:=
WolframRuleTestWSpec1[lhslen_Integer,rhslen_Integer,s_,n_]:=DeleteCases[ParallelMapMonitored[WolframRuleTestWSpec[lhslen,rhslen,s]&,Range[n]],$Aborted]
In[]:=
res=WolframRuleTestWSpec1[3,4,4,50];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
Out[]=
FewEvents30,DiedFast11,Disconnected7,BoringDifferences2
In[]:=
res=WolframRuleTestWSpec1[3,4,4,500];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
Out[]=
FewEvents361,DiedFast85,Disconnected35,BoringDifferences8,BoringDifferencesAfterTransient6,TooMuchOfAVertex5
In[]:=
res=WolframRuleTestWSpec1[3,4,6,500];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
Out[]=
DiedFast270,FewEvents163,Disconnected28,BoringDifferences24,BoringDifferencesAfterTransient10,TooMuchOfAVertex5
In[]:=
res=WolframRuleTestWSpec1[3,4,8,500];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
Out[]=
DiedFast336,FewEvents88,BoringDifferences44,Disconnected23,BoringDifferencesAfterTransient5,TooMuchOfAVertex4
In[]:=
res=WolframRuleTestWSpec1[3,5,8,500];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
Out[]=
DiedFast259,FewEvents120,Disconnected58,BoringDifferences45,BoringDifferencesAfterTransient14,TooMuchOfAVertex2,MaybeInteresting2
In[]:=
MakePictures[Select[res,WMFilter3[#]==="MaybeInteresting"&]]
Out[]=
In[]:=
PrintCells@{{{{0,1},{0,2},{0,3}}{{2,1},{2,3},{2,4},{3,3},{3,4}},{{0,0},{0,0},{0,0}},12},{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{2,3},{3,4},{4,2}},{{0,0},{0,0},{0,0}},16}};
{{{0,1},{0,2},{0,3}}{{2,1},{2,3},{2,4},{3,3},{3,4}},{{0,0},{0,0},{0,0}},12}
{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{2,3},{3,4},{4,2}},{{0,0},{0,0},{0,0}},16}
In[]:=
res=WolframRuleTestWSpec1[3,5,6,500];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
»
{2,0,-2,1}
Out[]=
FewEvents201,DiedFast173,Disconnected74,BoringDifferences24,BoringDifferencesAfterTransient21,MaybeInteresting6,LinearRecurrenceGrowth1
In[]:=
MakePictures[Select[res,WMFilter3[#]==="MaybeInteresting"&]]
»
{2,0,-2,1}
Out[]=
In[]:=
MakePictures[Select[res,WMFilter3[#]==="MaybeInteresting"&],1.5]
»
{2,0,-2,1}
Out[]=
In[]:=
PrintCells@{{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{3,4},{4,1},{4,3}},{{0,0},{0,0},{0,0}},16},{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{3,1},{3,4},{4,4}},{{0,0},{0,0},{0,0}},16},{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{2,4},{3,1},{4,4}},{{0,0},{0,0},{0,0}},16}};
In[]:=
Select[res,WMFilter3[#]==="MaybeInteresting"&][[{2,3}]]
»
{2,0,-2,1}
Out[]=
In[]:=
MakePictures[%,3]
Out[]=
[[ Took to SpecificRules-02 ]]
[[ Took to SpecificRules-02 ]]
In[]:=
PrintCells@{{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{3,4},{4,1},{4,3}},{{0,0},{0,0},{0,0}},16},{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{3,1},{3,4},{4,4}},{{0,0},{0,0},{0,0}},16},{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{2,4},{3,1},{4,4}},{{0,0},{0,0},{0,0}},16}};
{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{3,4},{4,1},{4,3}},{{0,0},{0,0},{0,0}},16}
{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{3,1},{3,4},{4,4}},{{0,0},{0,0},{0,0}},16}
{{{0,1},{0,2},{0,3}}{{1,2},{2,3},{2,4},{3,1},{4,4}},{{0,0},{0,0},{0,0}},16}
In[]:=
res=WolframRuleTestWSpec1[3,5,6,500];
In[]:=
ReverseSort[Counts[WMFilter3/@res]]
»
{2,0,-2,1}
Out[]=
FewEvents211,DiedFast159,Disconnected73,BoringDifferences34,BoringDifferencesAfterTransient13,MaybeInteresting6,TooMuchOfAVertex3,LinearRecurrenceGrowth1
In[]:=
MakePictures[Select[res,WMFilter3[#]==="MaybeInteresting"&]]
»
{2,0,-2,1}
Out[]=
Enumerate all
Enumerate all
{2,2}->{3,2} s4
{2,2}->{3,2} s4
{3,2}->{4,2} s4
{3,2}->{4,2} s4
Partials
Partials
Note this is from simple initial condition....