In[]:=
First/@SplitBy[SeedRandom[1234234+8452];TMAdaptiveList[InitTM[{4,2}],{4,2},{1,ConstantArray[0,60],30},200,1000],Last]
Out[]=
In[]:=
First/@SplitBy[SeedRandom[1234234+8452];TMAdaptiveList[InitTM[{3,2}],{3,2},{1,ConstantArray[0,60],30},200,1000],Last]
Out[]=
{{{{1,0}{0,0,0},{1,1}{0,1,0},{2,0}{0,0,0},{2,1}{0,1,0},{3,0}{0,0,0},{3,1}{0,1,0}},1},{{{1,0}{3,1,1},{1,1}{3,1,0},{2,0}{2,1,1},{2,1}{3,1,1},{3,0}{1,1,-1},{3,1}{0,1,0}},4},{{{1,0}{3,1,1},{1,1}{3,0,0},{2,0}{1,0,1},{2,1}{3,1,1},{3,0}{1,1,-1},{3,1}{0,1,0}},6},{{{1,0}{2,1,1},{1,1}{3,1,-1},{2,0}{1,0,-1},{2,1}{3,0,1},{3,0}{1,1,-1},{3,1}{0,1,-1}},7},{{{1,0}{2,1,1},{1,1}{3,1,-1},{2,0}{1,1,-1},{2,1}{3,1,-1},{3,0}{2,1,-1},{3,1}{0,1,1}},8},{{{1,0}{2,1,1},{1,1}{3,1,-1},{2,0}{1,1,-1},{2,1}{3,0,-1},{3,0}{2,0,1},{3,1}{0,0,1}},10}}
In[]:=
GraphicsRow[{RulePlot[TuringMachine[TMRuleHack@{{1,0}{2,1,-1},{1,1}{3,0,1},{2,0}{1,1,1},{2,1}{1,0,0},{3,0}{3,1,-1},{3,1}{1,0,0}}]],RulePlot[TuringMachine[TMRuleHack@{{1,0}{2,1,-1},{1,1}{3,0,1},{2,0}{1,1,1},{2,1}{1,0,0},{3,0}{3,1,-1},{3,1}{1,0,0}}],{{1,5},ConstantArray[0,9]},22,Mesh->True,MeshStyle->Opacity[.2],Frame->None]},Spacings->50]
Out[]=
In[]:=
GraphicsRow[{RulePlot[TuringMachine[{{1,0}{2,1,-1},{1,1}{3,0,1},{2,0}{1,1,1},{2,1}{1,0,0},{3,0}{3,1,-1},{3,1}{1,0,0}}]],RulePlot[TuringMachine[{{1,0}{2,1,-1},{1,1}{3,0,1},{2,0}{1,1,1},{2,1}{1,0,0},{3,0}{3,1,-1},{3,1}{1,0,0}}],{{1,5},ConstantArray[0,9]},22,Mesh->True,MeshStyle->Opacity[.2],Frame->None]},Spacings->50]
Out[]=
In[]:=
Mean[{-.1,-1.1}]
Out[]=
-0.6
In[]:=
TMRulePlot[rule_]:=Withs=Max[#[[1,1]]&/@rule],cr=<|0->White,1->
,2->Yellow|>,GraphicsRowGraphicsStyle[Rectangle[{-1/2,0},{1/2,1}],cr[#[[1,2]]],EdgeForm[GrayLevel[-1+GoldenRatio]]],
[◼]
FiniteStateIndicatorIcon
[{0,.5},{#[[1,1]],s}],If#[[2,3]]!=0,Style[Rectangle[{-1/2,-1.1},{1/2,-.1}],cr[#[[2,2]]],EdgeForm[GrayLevel[-1+GoldenRatio]]],
[◼]
FiniteStateIndicatorIcon
[{#[[2,3]],Mean[{-.1,-1.1}]},{#[[2,1]],s}],{Style[Rectangle[{-1/2,-1.1},{1/2,-.1}],White,EdgeForm[GrayLevel[-1+GoldenRatio]]],Style[Disk[{0,-.6},.3],Red]},PlotRange->{{-1.5,1.5},{-1.2,1.2}}&/@rule,Frame->All,FrameStyle->GrayLevel[.8]
In[]:=
TMRulePlot[{{1,0}{2,1,-1},{1,1}{3,0,1},{2,0}{1,1,1},{2,1}{1,0,0},{3,0}{3,1,-1},{3,1}{1,0,0}}]
Out[]=
In[]:=
TMEvolutionPlot[rule_,init_,t_,opts___]:=Module{data,stot=Max[#[[1,1]]&/@rule]},​​data={{#1,#3},#2}&@@@TMEvolveList[rule,init,t];​​Show​​ArrayPlot​​ArrayPad[data[[All,-1]],{{0},{1}}],​​ColorRules->0->White,1->
,2->Purple,​​opts​​,​​Graphics​​MapIndexed​​If#[[1,1]]!=0,
[◼]
FiniteStateIndicatorIcon
[{#[[1,2]]+1/2,Length[data]-First[#2]+1/2},{#[[1,1]],stot}],Style[Disk[{#[[1,2]]+1/2,Length[data]-First[#2]+1/2},.3],Red]&,​​data​​​​​​​​
In[]:=
TMEvolutionPlot[{{1,0}{2,1,1},{1,1}{2,0,0},{2,0}{1,1,-1},{2,1}{3,1,1},{3,0}{0,1,0},{3,1}{4,0,1},{4,0}{2,1,-1},{4,1}{1,0,0}},{1,Table[0,8],4},30,Mesh->True]
Out[]=
T
In[]:=
RulePlot[TuringMachine[{{1,0}{2,1,-1},{1,1}{3,0,1},{2,0}{1,1,1},{2,1}{1,0,0},{3,0}{3,1,-1},{3,1}{1,0,0}}]]
In[]:=
DominantColors[%186,7]
Out[]=

,
,

TuringMachineRulePlot[rule_,init_,t_,stot_:2,opts___]:=Module{data},​​data={{#1,#3},#2}&@@@TMEvolveList[rule,init,t];​​Show​​ArrayPlot​​ArrayPad[data[[All,-1]],{{0},{1}}],​​ColorRules->0->White,1->
,2->Purple,​​opts​​,​​Graphics​​MapIndexed​​
[◼]
FiniteStateIndicatorIcon
[{#[[1,2]]+1/2,Length[data]-First[#2]+1/2},{#[[1,1]],stot}]&,​​data​​​​​​​​

Multiway Case

Modifying here: