In[]:=
singleRow[list_]:=Mean[Last/@list]
In[]:=
singleHeads[list_,t_]:=KeyValueMap[Style[Disk[{#1-.5,t},.3],Opacity[#2]]&,(Counts[#]/Length[#])&[#[[1,2]]&/@list]]
In[]:=
MultiwayTuringGraphics[evol_]:=Show[ArrayPlot[singleRow/@evol,ColorFunction(Blend[{White,Orange},#]&)],Graphics[MapIndexed[singleHeads[#,.5+Length[evol]-First[#2]]&,evol]]]
In[]:=
MultiwayTuringGraphics[Map[ToExpression,With[{t=5},ResourceFunction["MultiwayTuringMachine"][{{{1,0}{1,0,-1}},{{1,0}{2,0,-1}},{{1,0}{2,0,1}},{{2,0}{2,0,1}}},{{1,t+1,0},Table[0,2t+1]},t]],{2}]]
Out[]=
In[]:=
Map[ToExpression,With[{t=5},ResourceFunction["MultiwayTuringMachine"][{{{1,0}{1,0,-1}},{{1,0}{2,0,-1}},{{1,0}{2,0,1}},{{2,0}{2,0,1}}},{{1,t+1,0},Table[0,2t+1]},t]],{2}]
Out[]=
In[]:=
Map[RulePlot[TuringMachine[{0,2,2}],#,0,MeshAll]&,%216,{2}]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
In[]:=
Map[RulePlot[TuringMachine[{0,2,2}],#,0,MeshAll]&,Map[ToExpression,With[{t=5},ResourceFunction["MultiwayTuringMachine"][{{{2,1}{1,0,1}},{{1,0}{2,0,-1}},{{1,0}{2,0,1}},{{1,0}{1,0,1}},{{2,0}{2,1,-1}}},{{1,t+1,0},Table[0,2t+1]},t]],{2}],{2}]
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
In[]:=
Graphics3D[MapIndexed[Inset[#,Append[#2,0]]&,%221,{2}]]
Out[]=
In[]:=
Graphics3D[MapIndexed[Inset[#,Append[#2,0],Center,50]&,%221,{2}]]
Out[]=