2,2 3,2
2,2 3,2
allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/22-32c.wxf"];
In[]:=
Length[allrules]
In[]:=
4702
Out[]=
ans=ParallelMapMonitored[TotalCausalInvariantQ[WolframModel[#],1]&,allrules];//AbsoluteTiming
In[]:=
{47.7159,Null}
Out[]=
Counts[ans]
In[]:=
True96,False4606
Out[]=
citest[1]=ParallelMapMonitored[TotalCausalInvariantQ[WolframModel[#],1]&,allrules];
In[]:=
Counts[citest[1]]
In[]:=
True96,False4606
Out[]=
InteractiveListSelectorSW[First/@GatherBy[Select[ParallelMapMonitored[FinalPicture2[#,5]#&,Pick[allrules,citest[1]]],ConnectedGraphQ[UndirectedGraph[First[#]]]&]]]
In[]:=
Out[]=
frules[1]=Pick[allrules,citest[1],False];
In[]:=
frules[t_]:=frules[t]=Pick[frules[t-1],citest[t],False]
In[]:=
citest[t_]:=citest[t]=ParallelMapMonitored[TotalCausalInvariantQ[WolframModel[#],t]&,frules[t-1]];
In[]:=
citest[2]
In[]:=
Counts[citest[2]]
In[]:=
False4485,True121
Out[]=
InteractiveListSelectorSW[First/@GatherBy[Select[ParallelMapMonitored[FinalPicture2[#,5]#&,Pick[frules[1],citest[2]]],ConnectedGraphQ[UndirectedGraph[First[#]]]&]]]
In[]:=
Out[]=
citest[t_]:=citest[t]=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],t],5]&,frules[t-1]];
In[]:=
citest[3];
In[]:=
Counts[citest[3]]
In[]:=
False4253,$Aborted220,True12
Out[]=
InteractiveListSelectorSW[First/@GatherBy[Select[ParallelMapMonitored[FinalPicture2[#,5]#&,Pick[frules[2],citest[3]]],ConnectedGraphQ[UndirectedGraph[First[#]]]&]]]
In[]:=
Out[]=
Additional Investigation (Causal Graphs)
Additional Investigation (Causal Graphs)
Last/@Select[ParallelMapMonitored[FinalPicture2[#,5]#&,Pick[allrules,ans]],ConnectedGraphQ[UndirectedGraph[First[#]]]&]
In[]:=
Out[]=
WolframModel[{{1,1},{1,1}}{{1,1},{1,1},{1,1}},{{0,0},{0,0}},12,"CausalGraph"]
In[]:=
Out[]=
ans=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],3],2]&,allrules]
In[]:=
Last/@Select[ParallelMapMonitored[FinalPicture2[#,5]#&,Pick[allrules,ans]],ConnectedGraphQ[UndirectedGraph[First[#]]]&]
In[]:=
Out[]=
Complement[%177,%171]
In[]:=
Out[]=
WolframModel[#,{{0,0},{0,0}},8,"CausalGraph"]&/@%
In[]:=
Out[]=
2,24,2
2,24,2
allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/22-42c.wxf"];
In[]:=
Length[allrules]
In[]:=
40405
Out[]=
ans=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],5]&,allrules];//AbsoluteTiming
In[]:=
{1126.82,Null}
Out[]=
Counts[ans]
In[]:=
False39048,$Aborted1357
Out[]=
Iconize[ans]
In[]:=
Out[]=
ans=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],2],5]&,allrules];//AbsoluteTiming
In[]:=
{1402.03,Null}
Out[]=
Counts[ans]
In[]:=
False34284,$Aborted6121
Out[]=
2,33,3
2,33,3
Iconize[Table[RandomWolframModel[{{2,3}}{{3,3}}],100]]
In[]:=
Out[]=
randrules=;
In[]:=
ans3=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],3],5]&,randrules];//AbsoluteTiming
In[]:=
{5.46732,Null}
Out[]=
ans3
In[]:=
{False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,$Aborted,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False}
Out[]=
Iconize[Table[RandomWolframModel[{{2,3}}{{3,3}}],3000]]
In[]:=
Out[]=
ParallelMapMonitoredTimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],5]&,
In[]:=
Out[]=
Pick,%
In[]:=
Out[]=
ParallelMapMonitored[FinalPicture[#,5]&,%]
In[]:=
Out[]=
The example rule
The example rule
TotalCausalInvariantQ[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}}],1]
In[]:=
False
Out[]=
TotalCausalInvariantQ[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}}],2]
In[]:=
False
Out[]=
TotalCausalInvariantQ[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}}],3]
In[]:=
False
Out[]=
TotalCausalInvariantQ[WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}}],4]//Timing
In[]:=
{75.3347,False}
Out[]=
Interesting rules
Interesting rules
irules=Import["/Users/sw/Dropbox/Physics/Data/InterestingRules-01.wxf"];
In[]:=
Length[irules]
In[]:=
855
Out[]=
RandomSample[irules,20]
In[]:=
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],5]&,%296]
In[]:=
{False,False,False,True,False,False,False,False,False,False,False,$Aborted,False,False,False,False,False,False,False,False}
Out[]=
%296[[4]]
In[]:=
{{1,1,2}}{{2,2,3},{1,2,2}}
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],4],5]&,%296]
In[]:=
{False,$Aborted,False,True,False,False,False,$Aborted,$Aborted,$Aborted,$Aborted,$Aborted,False,$Aborted,$Aborted,$Aborted,False,False,False,$Aborted}
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],2],5]&,%296]
In[]:=
{False,False,False,True,False,False,False,False,$Aborted,False,False,$Aborted,False,False,False,False,False,False,False,False}
Out[]=
ires=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],5]&,First/@irules];
In[]:=
Counts[ires]
In[]:=
True123,$Aborted107,False625
Out[]=
Pick[First/@irules,ires]
In[]:=
Out[]=
If[Head[#]===Rule,{#},#]&/@%173
In[]:=
Out[]=
Length[#[[1,1]]]&/@%
In[]:=
Out[]=
ires=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],10]&,irules];
In[]:=
Counts[ires]
In[]:=
True131,$Aborted81,False643
Out[]=
abortees1=Pick[irules,%188,$Aborted]
In[]:=
Out[]=
RuleSignatureForm[RuleToRuleSignature[#]]&/@%%
In[]:=
Out[]=
Select[abortees1,RuleToRuleSignature[#]{{{2,2}}{{5,2}}}&]
In[]:=
{{{{1,2},{2,3}}{{4,1},{4,3},{1,5},{5,3},{2,5}}},{{{1,2},{2,3}}{{4,2},{4,5},{2,3},{3,5},{1,5}}}}
Out[]=
Select[abortees1,RuleToRuleSignature[#]{{{3,2}}{{5,2}}}&]
In[]:=
Out[]=
Join[%374,%375]
In[]:=
Out[]=
First[%]
In[]:=
{{{1,2},{2,3}}{{4,1},{4,3},{1,5},{5,3},{2,5}}}
Out[]=
TotalCausalInvariantQ[WolframModel[{{{1,2},{2,3}}{{4,1},{4,3},{1,5},{5,3},{2,5}}}],1]
In[]:=
False
Out[]=
TotalCausalInvariantQ[WolframModel[{{{1,2},{1,3},{4,2}}{{5,1},{5,1},{5,3},{5,4},{1,2}}}],1]
In[]:=
False
Out[]=
ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],1],30]&,Join[%374,%375]]
In[]:=
Position[Transpose[{%170,ires}],{$Aborted,True}]//Flatten
In[]:=
{26,97,177,178,254,260,774,792}
Out[]=
irules[[%195]]
In[]:=
Out[]=
iirules=Select[irules,Length[#]1&&Length[#[[1,1]]]>1&];
In[]:=
Length[iirules]
In[]:=
699
Out[]=
iires=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],2],10]&,iirules];
In[]:=
Counts[%]
In[]:=
$Aborted88,False609,True2
Out[]=
Pick[iirules,iires]
In[]:=
{{{{1,2},{1,3}}{{2,1},{2,1},{2,4}}},{{{1},{1}}{{1},{1},{1}}}}
Out[]=
FinalPicture2[{{1,2},{1,3}}{{2,1},{2,1},{2,4}},10]
In[]:=
Out[]=
FinalPicture2[{{1,2},{1,3}}{{2,1},{2,1},{2,4}},15]
In[]:=
Out[]=
iires3=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],3],10]&,iirules];
In[]:=
Counts[iires3]
In[]:=
$Aborted223,False475,True1
Out[]=
Pick[iirules,iires3]
In[]:=
{{{{1},{1}}{{1},{1},{1}}}}
Out[]=
Graph[MultiwaySystem[WolframModel[{{1,2},{1,3}}{{2,1},{2,1},{2,4}}],{{0,0},{0,0}},4,"StatesGraph"],VertexSize1]
In[]:=
Out[]=
MultiwaySystem[WolframModel[{{1,2},{1,3}}{{2,1},{2,1},{2,4}}],{{0,0},{0,0}},5,"StatesGraphStructure"]
In[]:=
Out[]=
try3=Pick[iirules,iires3,False];
In[]:=
iires5=ParallelMapMonitored[TimeConstrained[TotalCausalInvariantQ[WolframModel[#],5],10]&,try3];
In[]:=
Counts[%]
In[]:=
False297,$Aborted178
Out[]=