In[]:=
FindLifetime[list_]:=If[#Length[list],None,#]&[First[FirstPosition[list,Last[list]]]]
In[]:=
MWTMEvolveList[rule_,inits:{{{_,_},_}...},t_Integer]:=NestList[Union[#,Catenate[Map[MWTMStep[rule,#]&,#]]]&,inits,t]
In[]:=
MWTMStep[rule_List,{{s_,n_},a_}]/;1≤n≤Length[a]:=Apply[{{#1,n+#3},ReplacePart[a,n->#2]}&,ReplaceList[{s,a〚n〛},rule],{1}]
In[]:=
TestTMs[s_,k_,p_,t_,max_]:=ResourceFunction["ParallelMapMonitored"][Function[rule,Catch[FindLifetime[Length/@NestList[With[{u=Union[#,Catenate[Map[MWTMStep[rule,#]&,#]]]},If[Length[u]>max,Throw[TooBig],u]]&,{{{1,t+1},Table[0,2t+1]}},t]]]],DeleteCases[Subsets[TMRuleCases[s,k],{p}],{}]]
In[]:=
TestTMsStates[s_,k_,p_,t_,max_]:=ResourceFunction["ParallelMapMonitored"][Function[rule,Catch[If[#[[-1]]#[[-2]],#[[-1]],None]&[Length/@NestList[With[{u=Union[#,Catenate[Map[MWTMStep[rule,#]&,#]]]},If[Length[u]>max,Throw[TooBig],u]]&,{{{1,t+1},Table[0,2t+1]}},t]]]],DeleteCases[Subsets[TMRuleCases[s,k],{p}],{}]]
In[]:=
TestTMsBatch[s_,k_,p_,t_,max_]:=ParallelMapMonitored[Function[rule,Catch[FindLifetime[Length/@NestList[With[{u=Union[#,Catenate[Map[MWTMStep[rule,#]&,#]]]},If[Length[u]>max,Throw[TooBig],u]]&,{{{1,t+1},Table[0,2t+1]}},t]]]],DeleteCases[Subsets[TMRuleCases[s,k],{p}],{}]]
In[]:=
ResourceFunction["ParallelMapMonitored"][FindLifetime[Length/@With[{t=6},MultiwayTuringMachine[#,{{1,t+1,0},Table[0,2t+1]},t]]]&,DeleteCases[Subsets[List/@TMRuleCases[2,2],{2}],{}]]
In[]:=
ResourceFunction["ParallelMapMonitored"][FindLifetime[Length/@With[{t=6},MWTMEvolveList[#,{{{1,t+1},Table[0,2t+1]}},t]]]&,DeleteCases[Subsets[TMRuleCases[2,2],{2}],{}]]
Out[]=
{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,2,2,2,None,None,3,3,None,None,3,3,2,2,None,None,4,2,None,None,None,None,2,3,3,None,None,3,3,None,None,4,2,None,None,None,None,None,None,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}
In[]:=
res2=TestTMs[2,2,2,100,10^5]
Out[]=
{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,None,None,None,None,2,2,2,2,1,1,1,1,1,1,1,1,TooBig,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,TooBig,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,None,2,2,2,None,None,3,3,None,None,3,3,2,2,None,None,4,2,None,None,None,None,2,3,3,None,None,3,3,None,None,4,2,None,None,None,None,None,None,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}
In[]:=
res3=TestTMs[2,2,3,30,10^5];
In[]:=
KeySort[Counts[res3]]
Out[]=
12024,2612,382,434,54,610,None2088,TooBig106
In[]:=
cases3=DeleteCases[Subsets[TMRuleCases[2,2],{3}],{}];
In[]:=
Length[cases3]
Out[]=
4960
In[]:=
Length[res3]
Out[]=
4960
In[]:=
Extract[cases3,#]&/@Flatten[Position[res3,6]]
Out[]=
{{{1,1}{2,1,-1},{1,0}{2,1,1},{2,0}{1,1,-1}},{{1,1}{2,0,-1},{1,0}{2,1,1},{2,0}{1,1,-1}},{{1,1}{2,1,1},{1,0}{2,1,-1},{2,0}{1,1,1}},{{1,1}{2,0,1},{1,0}{2,1,-1},{2,0}{1,1,1}},{{2,1}{1,1,-1},{1,0}{2,1,1},{2,0}{2,1,-1}},{{2,1}{1,1,-1},{1,0}{2,1,1},{2,0}{2,0,-1}},{{2,1}{1,1,1},{1,0}{2,1,-1},{2,0}{2,1,1}},{{2,1}{1,1,1},{1,0}{2,1,-1},{2,0}{2,0,1}},{{2,1}{2,1,-1},{1,0}{2,0,-1},{2,0}{1,1,1}},{{2,1}{2,1,1},{1,0}{2,0,1},{2,0}{1,1,-1}}}
In[]:=
Subsets[TMRuleCases[2,2],{3},{#}]&/@Flatten[Position[res3,6]]
Out[]=
{{{{1,1}{2,1,-1},{1,0}{2,1,1},{2,0}{1,1,-1}}},{{{1,1}{2,0,-1},{1,0}{2,1,1},{2,0}{1,1,-1}}},{{{1,1}{2,1,1},{1,0}{2,1,-1},{2,0}{1,1,1}}},{{{1,1}{2,0,1},{1,0}{2,1,-1},{2,0}{1,1,1}}},{{{2,1}{1,1,-1},{1,0}{2,1,1},{2,0}{2,1,-1}}},{{{2,1}{1,1,-1},{1,0}{2,1,1},{2,0}{2,0,-1}}},{{{2,1}{1,1,1},{1,0}{2,1,-1},{2,0}{2,1,1}}},{{{2,1}{1,1,1},{1,0}{2,1,-1},{2,0}{2,0,1}}},{{{2,1}{2,1,-1},{1,0}{2,0,-1},{2,0}{1,1,1}}},{{{2,1}{2,1,1},{1,0}{2,0,1},{2,0}{1,1,-1}}}}
In[]:=
TMAppliesGraph[List/@Flatten[#],8]&/@%
Out[]=
,
,
,
,
,
,
,
,
,
In[]:=
Subsets[TMRuleCases[2,2],{3},{#}]&/@Flatten[Position[res3,5]]
Out[]=
{{{{1,1}{1,1,-1},{1,0}{2,1,1},{2,0}{1,1,-1}}},{{{1,1}{1,1,-1},{1,0}{2,1,1},{2,0}{1,0,-1}}},{{{1,1}{1,1,1},{1,0}{2,1,-1},{2,0}{1,1,1}}},{{{1,1}{1,1,1},{1,0}{2,1,-1},{2,0}{1,0,1}}}}
In[]:=
TMAppliesGraph[List/@Flatten[#],8]&/@%
Out[]=
,
,
,
In[]:=
TMAppliesGraph[List/@Flatten[#],8]&/@Subsets[TMRuleCases[2,2],{3},{#}]&/@Flatten[Position[res3,4]]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
In[]:=
res4=TestTMs[2,2,4,14,10^5];
In[]:=
Max[%]
Out[]=
Max[7,None,TooBig]
In[]:=
KeySort[Counts[res4]]
Out[]=
110626,23265,3324,4166,526,654,72,None21496,TooBig1
In[]:=
cases4=DeleteCases[Subsets[TMRuleCases[2,2],{4}],{}];
In[]:=
Extract[cases4,Position[res4,TooBig]]
WRONG
WRONG
s=2, k=2 continued
s=2, k=2 continued
Random Sampling
Random Sampling
Max states....
Max states....
s=3, k=2
s=3, k=2
s=2, k=3
s=2, k=3
Deterministic
Deterministic