In[]:=
ggg=With[{t=4},MultiwayTuringMachine[AllDeltaTMRules[{2,2}],{{1,t+1,0},Table[0,2t+1]},t,"StatesGraphStructure",VertexSize1]];
In[]:=
With[{t=4},PathGraph[ToString/@TuringMachine[2506,{{1,t+1,0},Table[0,2t+1]},t]]]
Out[]=
In[]:=
With[{t=4},With[{g=MultiwayTuringMachine[AllDeltaTMRules[{2,2}],{{1,t+1,0},Table[0,2t+1]},t,"StatesGraphStructure",VertexSize1]},HighlightGraph[g,Style[Subgraph[g,PathGraph[ToString/@TuringMachine[2506,{{1,t+1,0},Table[0,2t+1]},t]]],Thickness[.01],Red]]]]
In[]:=
allrules=With[{s=2,k=2},Table[Flatten[MapIndexed[{1,-1}#2+{0,k}{1,1,2}Mod[Quotient[#1,{2k,2,1}],{s,k,2}]+{1,0,-1}&,Partition[IntegerDigits[n,2sk,sk],k],{2}]],{n,0,4095}]];
In[]:=
o0[{s1_,k1_}{s2_,k2_,o_}]:={s1,k1}{s2,k2,-o}
In[]:=
minrule[r_]:=First[Sort[Sort/@{r,o0/@r}]]
In[]:=
Union[minrule/@allrules]
Out[]=
In[]:=
Keys[ReverseSort[Counts[RulePlot[TuringMachine[#],{1,{{},0}},9,ImageSize{Automatic,45},FrameStyleLightGray]&/@Union[minrule/@allrules]]]]
In[]:=
First/@GatherBy[%89,RulePlot[TuringMachine[#],{1,{{},0}},9]&]
Out[]=
In[]:=
With[{t=4},HighlightGraph[ggg,Style[Subgraph[ggg,PathGraph[Rule@@@Partition[ToString/@TuringMachine[#,{{1,t+1,0},Table[0,2t+1]},t],2,1]]],Thickness[.01],Red]]]&/@Take[%90,{5,6}]
Out[]=
In[]:=
With[{t=4},PathGraph[Rule@@@Partition[ToString/@TuringMachine[%90[[5]],{{1,t+1,0},Table[0,2t+1]},t],2,1]]]
Out[]=
In[]:=
With[{t=4},HighlightGraph[ggg,Style[PathGraph[Rule@@@Partition[ToString/@TuringMachine[#,{{1,t+1,0},Table[0,2t+1]},t],2,1]],Thickness[.01],Red]]]&/@Take[%90,{5,6}]
Out[]=
In[]:=
%90[[5]]
Out[]=
{{1,0}{2,0,-1},{1,1}{1,0,-1},{2,0}{1,1,-1},{2,1}{1,0,-1}}
In[]:=
RulePlot[TuringMachine[%]]
Out[]=