MultiwaySystem[WolframModel[encodeTMRule[{{2,1}{2,1,1},{2,0}{1,0,1},{2,0}->{2,1,-1},{1,1}{2,1,1},{1,0}{2,0,-1}},0]],encodeTMState[{1,1},{0}],7,"StatesGraph",VertexSize1]//LayeredGraphPlot
In[]:=
Out[]=
MultiwaySystem[WolframModel[encodeTMRule[{{2,1}{2,1,1},{2,0}{1,0,1},{2,0}->{2,1,-1},{1,1}{2,1,1},{1,0}{2,0,-1}},0]],encodeTMState[{1,1},{0}],7,"StatesGraphStructure"]//LayeredGraphPlot
In[]:=
Out[]=
MultiwaySystem[WolframModel[encodeTMRule[{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,2,1}},0]],encodeTMState[{1,1},{0}],6,"StatesGraph",VertexSize1]
In[]:=
Out[]=
MultiwaySystem[WolframModel[encodeTMRule[{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,1,-1}},0]],encodeTMState[{1,1},{0}],6,"StatesGraph",VertexSize1]
In[]:=
Out[]=
LNTMEvolveList[rule_List,init_,seq_]:=FoldList[LNTMStep[rule,#1,#2]&,init,seq]
LNTMStep[rule_List,{s_,a_,n_},i_]/;(1≤n≤Length[a]):=Apply[{#1,ReplacePart[a,#2,n],n+#3}&,Replace[{s,a[[n]]},rule][[i]]]
TuringMachine[{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,2,1}}]
{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,2,1}}
Tuples[{{{1,0}{2,1,1},{1,0}{2,1,-1}},{{2,0}{1,2,-1},{2,0}{1,2,1}}}]
In[]:=
Out[]=
tmr=Join[{{1,2}{1,1,-1},{1,1}{1,2,-1},{2,2}{1,0,1},{2,1}{2,2,1}},#]&/@Tuples[{{{1,0}{2,1,1},{1,0}{2,1,-1}},{{2,0}{1,2,-1},{2,0}{1,2,1}}}]
In[]:=
Out[]=
encodeTMRule[{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,2,1}},0]
In[]:=
encodeTMRule[{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,2,1}},0]
Out[]=
Dimensions[%]
In[]:=
{4,6}
Out[]=
TuringMachine[
TuringMachine[2506,{1,{{},0}},0]//First
In[]:=
{{1,1,0},{0}}
Out[]=
TuringMachine[tmr[[1]]][{{1,1,0},{0}}]
In[]:=
{{2,1,1},{1}}
Out[]=
NestGraph[h/@(Through[(TuringMachine/@tmr)@First[#]])&,{h[{1,{{},0}}]},6]
In[]:=
Out[]=
Out[]=
NestGraph[h/@(Through[(TuringMachine/@tmr)@First[#]])&,{h[{1,{{},0}}]},3,VertexLabelsAutomatic]
In[]:=
Out[]=
VertexReplace[NestGraph[h/@(Through[(TuringMachine/@tmr)@First[#]])&,{h[{1,{{},0}}]},3],h[{{a_,b_,_},s_}]OutputForm[{{a,b},s}],VertexLabelsAutomatic]
In[]:=
Out[]=
VertexReplace[MultiwaySystem[WolframModel[encodeTMRule[{{1,2}{1,1,-1},{1,1}{1,2,-1},{1,0}{2,1,1},{1,0}{2,1,-1},{2,2}{1,0,1},{2,1}{2,2,1},{2,0}{1,2,-1},{2,0}{1,2,1}},0]],encodeTMState[{1,1},{0}],5,"StatesGraphStructure",VertexSize1],(v_OutputForm[decodeState[v]]),VertexLabels"Name"]
In[]:=
Out[]=
LayeredGraphPlot[VertexReplace[NestGraph[h/@(Through[(TuringMachine/@tmr)@First[#]])&,{h[{1,{{},0}}]},15],h[{{a_,b_,_},s_}]OutputForm[{{a,b},s}]],AspectRatio1/2]
In[]:=
Out[]=
VertexReplace[NestGraph[h/@(Through[(TuringMachine/@tmr)@First[#]])&,{h[{1,{{},0}}]},17],h[{{a_,b_,_},s_}]OutputForm[{{a,b},s}]]
In[]:=
Out[]=

NDCA

encodeCARule[110,0]
In[]:=
Out[]=
MultiwaySystem[WolframModel[encodeCARule[110,0]],{encodeCAState[{1}]},2,"StatesGraph"]
In[]:=
$Aborted
Out[]=
MultiwaySystem[WolframModel[encodeCARule[110,0]],{encodeCAState[{1}]},1,"StatesGraph"]
In[]:=
$Aborted
Out[]=