In[]:=
allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/22-42c.wxf"];
In[]:=
Length[allrules]
Out[]=
40405
In[]:=
pall=Function[perm,perm->Pick[allrules,ParallelMapMonitored[(FindCanonicalWolframModel[Map[#[[perm]]&,#,{2}]]===#)&,allrules]]]/@Rest[Permutations[Range[2]]]
Out[]=
In[]:=
Length[Last[First[%]]]
Out[]=
363
In[]:=
srules=Last[First[pall]]
Out[]=
In[]:=
rsrules=ParallelMapMonitored[WolframModelTest[#,Automatic]&,srules];
In[]:=
MakePictures2@rsrules
Out[]=
In[]:=
WolframModelPlot[WolframModel[#1,#2,#3,"FinalState"]]&@@@{{{{1,2},{2,3}}{{1,2},{1,4},{2,3},{4,3}},{{0,0},{0,0}},6},{{{1,2},{2,3}}{{1,4},{1,3},{4,5},{5,3}},{{0,0},{0,0}},7}}
Out[]=
In[]:=
WolframModelPlot[WolframModel[#1,#2,#3,"FinalState"]]&@@@{{{{1,2},{2,3}}{{1,2},{1,4},{2,3},{4,3}},{{0,0},{0,0}},8},{{{1,2},{2,3}}{{1,4},{1,3},{4,5},{5,3}},{{0,0},{0,0}},9}}
Out[]=
In[]:=
WolframModelPlot[WolframModel[#1,#2,#3,"FinalState"]]&@@@{{{{1,2},{2,3}}{{1,2},{1,4},{2,3},{4,3}},{{0,0},{0,0}},10},{{{1,2},{2,3}}{{1,4},{1,3},{4,5},{5,3}},{{0,0},{0,0}},11}}
Out[]=
In[]:=
WolframModel[#1,#2,#3]["StatesPlotsList",ImageSize40]&@@@{{{{1,2},{2,3}}{{1,2},{1,4},{2,3},{4,3}},{{0,0},{0,0}},7},{{{1,2},{2,3}}{{1,4},{1,3},{4,5},{5,3}},{{0,0},{0,0}},7}}
Out[]=
The ternary case
The ternary case
In[]:=
allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/23-33c.wxf"];
In[]:=
Length[allrules]
Out[]=
79359764
In[]:=
pall=Function[perm,permEchoFunction[Length][Pick[allrules,ParallelMapMonitored[(FindCanonicalWolframModel[Map[#[[perm]]&,#,{2}]]===#)&,allrules]]]]/@Rest[Permutations[Range[3]]]
»
63028
»
63028
Out[]=
$Aborted
Now
NotebookSave[]
In[]:=
Length[allrules]
Out[]=
79359764
In[]:=
Permutations[Range[3]]
Out[]=
{{1,2,3},{1,3,2},{2,1,3},{2,3,1},{3,1,2},{3,2,1}}
In[]:=
ParallelMapMonitored[If[FindCanonicalWolframModel[Map[#[[{2,3,1}]]&,#,{2}]]===#,Echo[#];True,False]&,allrules]
Out[]=
$Aborted