In[]:=
TMRuleCases[s_Integer,k_Integer]:=TMRuleCases[s,k]=Flatten[Table[{s0,c0}{s1,c1,d},{c0,k-1,0,-1},{s0,1,s},{s1,1,s},{d,{-1,1}},{c1,k-1,0,-1}],4]
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[]:=
serialTestTMs[s_,k_,p_,t_,max_]:=Map[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}],{}]]

Max’s code

In[]:=
Needs["PostTagSystem`"]
In[]:=
?NDTMEvaluate
Out[]=
Symbol
NDTMEvaluate[rules,eventLimit,stateLimit] evaluates an NDTM and returns the max event count and a total statecount.
NDTMEvaluate[

Tom’s code [12.3 only]

In[]:=
twjNDTM=LibraryFunctionLoad["/Users/sw/Dropbox/Physics/CodeDevelopment/CompiledLibraries/NDTM-TWJ-01.dylib"]
Out[]=
CompiledCodeFunction
Signature: {TypeSpecifier[ListArray][MWTMRule],TypeSpecifier[ListArray][MWTMState],Integer64}TypeSpecifier[ListArray][TypeSpecifier[ListArray][MWTMState]]

In[]:=
twjNDTM[{{1,1}{2,1,1},{1,0}{2,0,1},{2,0}{1,1,-1},{2,0}{1,0,-1},{2,1}{1,0,-1},{2,1}{1,1,-1}},{{{1,1},{0,0,0,0,0,0}}},10^3]
Out[]=
{{{{1,1},{0,0,0,0,0,0}}},{{{2,2},{0,0,0,0,0,0}},{{1,1},{0,0,0,0,0,0}}},{{{1,1},{0,1,0,0,0,0}},{{2,2},{0,0,0,0,0,0}},{{1,1},{0,0,0,0,0,0}}},
⋯995⋯
,{{{2,2},{0,1,0,0,0,0}},{{1,1},{0,1,0,0,0,0}},{{2,2},{0,0,0,0,0,0}},{{1,1},{0,0,0,0,0,0}}},{{{2,2},{0,1,0,0,0,0}},{{1,1},{0,1,0,0,0,0}},{{2,2},{0,0,0,0,0,0}},{{1,1},{0,0,0,0,0,0}}},{{{2,2},{0,1,0,0,0,0}},{{1,1},{0,1,0,0,0,0}},{{2,2},{0,0,0,0,0,0}},{{1,1},{0,0,0,0,0,0}}}}
large output
show less
show more
show all
set size limit...
In[]:=
Length/@%3
Out[]=
In[]:=
twjTestTMs[s_,k_,p_,t_,max_]:=Map[Function[rule,FindLifetime[Length/@twjNDTM[rule,{{{1,t+1},Table[0,2t+1]}},t]]],DeleteCases[Subsets[TMRuleCases[s,k],{p}],{}]]
In[]:=
Counts[twjTestTMs[2,2,3,10,None]]
Out[]=
12024,None2194,2612,382,434,54,610
In[]:=
Counts[twjTestTMs[2,2,3,10,None]]//AbsoluteTiming
Out[]=
{1.51195,12024,None2194,2612,382,434,54,610}
In[]:=
Counts[serialTestTMs[2,2,3,10,1000]]
Out[]=
12024,None2128,2612,TooBig66,382,434,54,610
In[]:=
Counts[serialTestTMs[2,2,3,10,1000]]//AbsoluteTiming
Out[]=
{4.38606,12024,None2128,2612,TooBig66,382,434,54,610}
In[]:=
Counts[serialTestTMs[2,2,3,10,100]]//AbsoluteTiming
Out[]=
{3.13231,12024,None2032,2612,TooBig162,382,434,54,610}
{1,0,1,1,0,0,1,1,1,0
In[]:=
$Version
Out[]=
12.3.0 for Mac OS X x86 (64-bit) (January 28, 2021)

Multiplatform

In[]:=
TMRuleCases[s_Integer,k_Integer]:=TMRuleCases[s,k]=Flatten[Table[{s0,c0}{s1,c1,d},{c0,k-1,0,-1},{s0,1,s},{s1,1,s},{d,{-1,1}},{c1,k-1,0,-1}],4]
In[]:=
FindLifetime[list_]:=If[#Length[list],None,#]&[First[FirstPosition[list,Last[list]]]]
In[]:=
FindLifetime["TooBig"]:=TooBig

More code


Back again...

In[]:=
twjTestTMs[s_,k_,p_,t_,max_]:=Map[Function[rule,FindLifetime[Length/@twjNDTM[rule,{{{1,t+1},Table[0,2t+1]}},t]]],DeleteCases[Subsets[TMRuleCases[s,k],{p}],{}]]
In[]:=
paratwjTestTMs[s_,k_,p_,t_,max_]:=ResourceFunction["ParallelMapMonitored"][Function[rule,FindLifetime[Length/@twjNDTM[rule,{{{1,t+1},Table[0,2t+1]}},t,max]]],DeleteCases[Subsets[TMRuleCases[s,k],{p}],{}]]
In[]:=
subparatwjTestTMs[s_,k_,p_,t_,max_]:=ParallelTable[If[Divisible[i,100000],PrintTemporary[i]];FindLifetime[Length/@twjNDTM[First[Subsets[TMRuleCases[s,k],{p},{i}]],{{{1,t+1},Table[0,2t+1]}},t,max]],{i,Binomial[Length[TMRuleCases[s,k]],p]}]
In[]:=
twjNDTM=LibraryFunctionLoad[If[$SystemID==="Linux-x86-64","/Users/sw/Dropbox/Physics/CodeDevelopment/CompiledLibraries/NDTM-TWJ-01.so","/Users/sw/Dropbox/Physics/CodeDevelopment/CompiledLibraries/NDTM-TWJ-01.dylib"]];
In[]:=
ParallelEvaluate[twjNDTM=LibraryFunctionLoad[If[$SystemID==="Linux-x86-64","/Users/sw/Dropbox/Physics/CodeDevelopment/CompiledLibraries/NDTM-TWJ-01.so","/Users/sw/Dropbox/Physics/CodeDevelopment/CompiledLibraries/NDTM-TWJ-01.dylib"]]]
In[]:=
ParallelEvaluate[Off[Last::normal]];
In[]:=
Counts[res2=subparatwjTestTMs[2,2,2,20,1000]]
Out[]=
None412,272,NotFound2,38,42
In[]:=
First[Subsets[TMRuleCases[2,2],{2},{#}]]&/@Flatten[Position[res2,"NotFound"]]
Out[]=
{{{1,0}{1,1,-1},{1,0}{1,0,-1}},{{1,0}{1,1,1},{1,0}{1,0,1}}}
In[]:=
With[{t=10},twjNDTM[{{1,0}{1,1,-1},{1,0}{1,0,-1}},{{{1,t+1},Table[0,2t+1]}},10,100]]
"TooBig"
In[]:=
Counts[res2=subparatwjTestTMs[2,2,2,30,10000]]
Out[]=
None412,272,NotFound2,38,42
In[]:=
Counts[res3=paratwjTestTMs[2,2,3,10,1000]]//AbsoluteTiming
Out[]=
{5.69783,None4152,2612,NotFound66,382,434,54,610}
In[]:=
Counts[res3=subparatwjTestTMs[2,2,3,20,10000]]//AbsoluteTiming
Out[]=
{0.524107,None4122,2612,NotFound96,382,434,54,610}
In[]:=
Counts[subparatwjTestTMs[2,2,3,20,10000]]//AbsoluteTiming
Out[]=
{0.561214,None4122,2612,NotFound96,382,434,54,610}
In[]:=
Counts[res4=paratwjTestTMs[2,2,4,20,1000]]//AbsoluteTiming
Out[]=
{44.6809,None29524,23265,NotFound2599,3324,4166,654,526,72}
In[]:=
Counts[res4=subparatwjTestTMs[2,2,4,20,1000]]//AbsoluteTiming
Out[]=
{33.4635,None29524,23265,NotFound2599,3324,4166,654,526,72}
Out[]=
{Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null}
In[]:=
Counts[res5=subparatwjTestTMs[2,2,5,20,1000]]//AbsoluteTiming
(kernel 27)
100000
(kernel 17)
200000
Out[]=
{17.8444,None152530,212256,NotFound35232,3770,4440,692,548,76,82}
In[]:=
Position[res5,8]//Flatten
Out[]=
{128411,148434}

s=3, k=2

State maximization

s=3, k=2