allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/22-22c.wxf"];
In[]:=
Length[allrules]
In[]:=
562
Out[]=
t10=Flatten/@List@@@EdgeList@TorusGraph[{10}]
In[]:=
{{1,2},{2,3},{3,4},{4,5},{5,6},{6,7},{7,8},{8,9},{9,10},{10,1}}
Out[]=
InteractiveListSelectorSW[First/@GatherBy[ParallelMapMonitored[Graph[Rule@@@(WolframModelTest[#,t10]["FinalState"])]#&,allrules],First]]
In[]:=
Out[]=
InteractiveListSelectorSW[First/@GatherBy[ParallelMapMonitored[Graph[Rule@@@(WolframModelTest[#,t10]["EvolutionObject"]["CausalGraph"])]#&,allrules],First]]
In[]:=
Out[]=
ParallelMapMonitored[With[{w=WolframModel[#,t10,20]},{HypergraphPlot[w["FinalState"]],w["CausalGraph"]}]&,{{{1,2},{2,3}}{{1,3},{1,3}},{{1,2},{2,3}}{{1,1},{2,3}},{{1,2},{2,3}}{{2,2},{1,3}},{{1,2},{2,3}}{{3,1},{3,2}},{{1,2},{2,3}}{{1,3},{1,4}},{{1,2},{2,3}}{{3,3},{1,2}}}]
In[]:=
Out[]=
ParallelMapMonitored[With[{w=WolframModel[#,t10,30]},{HypergraphPlot[w["FinalState"]],w["CausalGraph"]}]&,{{{1,2},{2,3}}{{1,3},{1,3}},{{1,2},{2,3}}{{1,1},{2,3}},{{1,2},{2,3}}{{2,2},{1,3}},{{1,2},{2,3}}{{3,1},{3,2}},{{1,2},{2,3}}{{1,3},{1,4}},{{1,2},{2,3}}{{3,3},{1,2}}}]
In[]:=
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],4]&,allrules]
In[]:=
Out[]=
Counts[%]
In[]:=
False538,$Aborted24
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],2],4]&,allrules]
Out[]=
Counts[%]
In[]:=
False562
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],3],4]&,allrules]
In[]:=
Out[]=
.
HypergraphPlot/@WolframModel[{{1,2},{2,3}}{{1,3},{1,3}},t10,15,"StatesList"]
In[]:=
Out[]=
HypergraphPlot/@WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},t10,40,"StatesList"]
In[]:=
Out[]=
HypergraphPlot/@WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},Table[{i,i+1},{i,5}],70,"StatesList"]
In[]:=
Out[]=
FindTransientRepeat[%91,2]
In[]:=
Out[]=
Length[%]
In[]:=
2
Out[]=
Length/@%%
In[]:=
{5,30}
Out[]=
all32=EnumerateHypergraphs[{{3,2}}];
In[]:=
res32=ParallelMapMonitored[#->FindCanonicalHypergraph[Last[WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},#,1,"StatesList"]]]&,all32];
In[]:=
panelLabel[lbl_]:=Panel[Framed[lbl,FrameStyleGray,BackgroundLighter[Blue,0.9]],FrameMargins0]
In[]:=
Graph[res32,VertexLabels((First[#]->Placed[HypergraphPlot[First[#],ImageSize20],Center,panelLabel]&/@res32)),PerformanceGoal"Quality",EdgeStyleDarker[Green,.6]]
In[]:=
Out[]=
res52=ParallelMapMonitored[#->FindCanonicalHypergraph[Last[WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},#,1,"StatesList"]]]&,all52];
In[]:=
Graph[res52,EdgeStyleDarker[Green,.6],VertexStyle->Lighter[Blue,0.9]]
In[]:=
Out[]=
ParallelTable[Length/@FindTransientRepeat[WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},Table[{i,i+1},{i,n}],1000,"StatesList"],2],{n,20}]
In[]:=
{{1,0},{2,0},{2,0},{4,0},{5,30},{3,4},{9,6},{9,0},{34,90},{55,147},{1001,0},{9,0},{1001,0},{17,6},{262,4},{12,0},{1001,0},{167,0},{1001,0},{329,0}}
Out[]=
ParallelTable[Length/@FindTransientRepeat[WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,n}],1000,"StatesList"],2],{n,20}]
In[]:=
{{1,0},{2,0},{2,0},{4,0},{5,6},{3,4},{9,28},{6,0},{8,42},{5,6},{15,186},{10,24},{10,360},{7,28},{33,6},{10,0},{40,450},{9,84},{1001,0},{17,84}}
Out[]=
Last/@%
In[]:=
{0,0,0,0,6,4,28,0,42,6,186,24,360,28,6,0,450,84,0,84}
Out[]=
ListLogPlot[%113,AspectRatio1/4,PlotRangeAll,JoinedTrue]
In[]:=
Out[]=
Length/@FindTransientRepeat[WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,5}],40,"StatesList"],3]
In[]:=
{5,6}
Out[]=
HypergraphPlot/@WolframModel[{{1,2},{2,3}}{{2,1},{3,1}},Table[{i,i+1},{i,5}],15,"StatesList"]
In[]:=
Out[]=
Union[%%]
In[]:=
Out[]=
WolframModel[{{x,y},{y,z}}{{z,x},{z,y}},Table[{i,i+1},{i,8}],70,"CausalGraph"]
In[]:=
Out[]=
WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},Table[{i,i+1},{i,9}],30,"CausalGraph"]//LayeredGraphPlot
In[]:=
Out[]=
LayeredGraphPlot[%]
In[]:=
Out[]=
WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},Table[{i,i+1},{i,5}],30,"CausalGraph"]
In[]:=
Out[]=
VertexCount[%94]
In[]:=
85
Out[]=
HypergraphPlot/@WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},Table[{i,i+1},{i,5}],70,"StatesList"]
Length[%]
In[]:=
71
Out[]=
Length[%]
In[]:=
71
Out[]=
Length[%]
In[]:=
31
Out[]=
XYifyRule[{{1,2},{2,3}}{{3,1},{3,2}}]
In[]:=
{{x,y},{y,z}}{{z,x},{z,y}}
Out[]=
WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},t10,40,"CausalGraph"]
In[]:=
Out[]=
WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},Table[{i,i+1},{i,10}],80,"CausalGraph"]
In[]:=
Out[]=
WolframModel[{{x,y},{y,z}}{{y,x},{z,x}},Table[{i,i+1},{i,10}],80,"CausalGraph"]
In[]:=
Out[]=
{{1,2},{2,3}}{{3,1},{3,2}}
RuleSignatureForm[{{2,2}}{{2,2}}]
In[]:=
2
2
2
2
Out[]=
{{x,y},{y,z}}{{y,x},{z,x}}
all52
all52=EnumerateHypergraphs[{{5,2}}];
In[]:=
res52=ParallelMapMonitored[#->FindCanonicalHypergraph[Last[WolframModel[{{1,2},{2,3}}{{3,1},{3,2}},#,1,"StatesList"]]]&,all52];
In[]:=
Graph[res52]
In[]:=
Out[]=
“Particles”
“Particles”
EvolutionPicture2[#,Table[{i,Mod[i+1,21]},{i,0,20}],10]&/@{{{1,2},{2,3}}{{1,2},{2,3}},{{1,2},{2,3}}{{2,3},{3,1}},{{1,2},{2,3}}{{3,1},{1,2}}}
In[]:=
Out[]=
EvolutionPicture2[#,Table[{i,i+1},{i,0,20}],10]&/@{{{1,2},{2,3}}{{1,2},{2,3}},{{1,2},{2,3}}{{2,3},{3,1}},{{1,2},{2,3}}{{3,1},{1,2}}}
In[]:=
Out[]=
WolframModel[#,Table[{i,Mod[i+1,21]},{i,0,20}],30,"CausalGraph"]&/@{{{1,2},{2,3}}{{1,2},{2,3}},{{1,2},{2,3}}{{2,3},{3,1}},{{1,2},{2,3}}{{3,1},{1,2}}}
In[]:=
Out[]=
WolframModel[#,Table[{i,i+1},{i,0,20}],30,"CausalGraph"]&/@{{{1,2},{2,3}}{{1,2},{2,3}},{{1,2},{2,3}}{{2,3},{3,1}},{{1,2},{2,3}}{{3,1},{1,2}}}
In[]:=
Out[]=
XYifyRule[{{1,2},{2,3}}{{1,2},{2,3}}]
In[]:=
{{x,y},{y,z}}{{x,y},{y,z}}
Out[]=
HypergraphPlot[Table[{i,i+1},{i,0,4}]]
In[]:=
Out[]=
Arity 3
Arity 3
allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/23-23c.wxf"];
In[]:=
Length[%]
In[]:=
772696
Out[]=
RandomSample[allrules,1000];
In[]:=
ans=ParallelMapMonitored[TotalCausalInvariantQ[WolframModel[{#}],1]&,%251];
In[]:=
Counts[ans]
In[]:=
False1000
Out[]=
ans=ParallelMapMonitored[TotalCausalInvariantQ[{#},2]&,%251];
In[]:=
Counts[ans]
In[]:=
False1000
Out[]=
ParallelMapMonitored[CanonicalCriticalPairs[WolframModel[{#}]]&,Take[%251,10]]
In[]:=
Out[]=
Length/@%
In[]:=
{49,40,20,9,36,25,40,36,9,28}
Out[]=