In[]:=
Subsets[Range[4]]
Out[]=
{{},{1},{2},{3},{4},{1,2},{1,3},{1,4},{2,3},{2,4},{3,4},{1,2,3},{1,2,4},{1,3,4},{2,3,4},{1,2,3,4}}
In[]:=
RemoveCases[rule_,subs_]:=ReplacePart[rule,{#,2,3}0&/@subs]
In[]:=
allrules=Union[Flatten[Table[With[{r=ResourceFunction["TuringMachineFromNumber"][i]},RemoveCases[r,#]&/@{{1},{2},{3},{4},{1,2},{1,3},{1,4},{2,3},{2,4},{3,4}}],{i,0,4095}],1]];
In[]:=
Length[allrules]
Out[]=
14336
In[]:=
Length[First[FindTransientRepeat[TuringMachine[#,{1,{{},0}},40],5]]]&/@Take[allrules,10]
Out[]=
{41,41,41,41,41,41,41,41,41,41}
In[]:=
RulePlot[TuringMachine[#],{1,{{},0}},40]&/@Take[allrules,10]
In[]:=
lens=ResourceFunction["ParallelMapMonitored"][Length[First[FindTransientRepeat[TuringMachine[#,{1,{{},0}},40],5]]]&,allrules];
In[]:=
Counts[%]
Out[]=
4111218,01830,1890,2292,374,412,520
In[]:=
Position[lens,5]
Out[]=
{{4725},{5478},{5688},{5757},{5760},{5927},{5930},{6949},{7648},{8308},{9392},{9583},{10079},{10534},{11181},{11184},{11892},{13591},{13594},{14118}}
In[]:=
RulePlot[TuringMachine[allrules[[#]]],{1,{{},0}},40]&/@Flatten[%]
Out[]=

,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,

In[]:=
Select[allrules[[Flatten[{{4725},{5478},{5688},{5757},{5760},{5927},{5930},{6949},{7648},{8308},{9392},{9583},{10079},{10534},{11181},{11184},{11892},{13591},{13594},{14118}}]]],Length[Last[FindTransientRepeat[TuringMachine[#,{1,{{},0}},40],5]]]1&]
Out[]=
{{{1,1}{1,1,-1},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,0}},{{1,1}{1,1,0},{1,0}{2,0,-1},{2,1}{2,1,-1},{2,0}{1,1,1}},{{1,1}{1,1,0},{1,0}{2,0,1},{2,1}{2,1,1},{2,0}{1,1,-1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,0,1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,1,1}},{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,1,-1},{2,0}{2,0,-1}},{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,1,-1},{2,0}{2,1,-1}},{{1,1}{1,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,0}},{{1,1}{2,0,-1},{1,0}{1,1,0},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,0,-1},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,0},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,0,0},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,1},{1,0}{1,1,0},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,1,-1},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}}}
In[]:=
RulePlot[TuringMachine[#],{1,{{},0}},5]&/@%432
In[]:=
RulePlot[TuringMachine[{0,2,2}],#]&/@SortBy[TuringMachine[#,{1,{{},0}},5]&/@%432,#[[-1,-1]]&]
In[]:=
Length[%432]
Out[]=
16
In[]:=
bbrules={{{1,1}{1,1,-1},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,0}},{{1,1}{1,1,0},{1,0}{2,0,-1},{2,1}{2,1,-1},{2,0}{1,1,1}},{{1,1}{1,1,0},{1,0}{2,0,1},{2,1}{2,1,1},{2,0}{1,1,-1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,0,1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,1,1}},{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,1,-1},{2,0}{2,0,-1}},{{1,1}{1,1,0},{1,0}{2,1,1},{2,1}{1,1,-1},{2,0}{2,1,-1}},{{1,1}{1,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,0}},{{1,1}{2,0,-1},{1,0}{1,1,0},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,0,-1},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,0},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,0,0},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,1},{1,0}{1,1,0},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,1,-1},{1,0}{2,1,1},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}}};
In[]:=
ResourceFunction["InteractiveListSelector"][RulePlot[TuringMachine[#],{1,{{},0}},5]#&/@bbrules]
Out[]=

Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add
,
Add

Clear
Copy
In[]:=
bbrules8={{{1,1}{1,1,0},{1,0}{2,0,1},{2,1}{2,1,1},{2,0}{1,1,-1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,0,1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,1,1}},{{1,1}{1,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,0}},{{1,1}{2,0,0},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,0,1},{1,0}{1,1,0},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{2,0,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}}};
In[]:=
TuringMachinePlot[DeleteCases[#,_{_,_,0}],2,2,"RulePlot"]&/@bbrules8
Out[]=

,
,
,
,
,
,
,

In[]:=
TakeList[Labeled[RulePlot[TuringMachine[#],{{1,4},Table[0,7]},5,MeshTrue,FrameNone,ImageSize100],TuringMachinePlot[DeleteCases[#,_{_,_,0}],2,2,"RulePlot",ImageSize{Automatic,40}]]&/@{{{1,1}{1,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,0}},{{1,1}{2,0,0},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,0,1},{1,0}{1,1,0},{2,1}{2,1,0},{2,0}{1,1,-1}},{{1,1}{1,1,0},{1,0}{2,0,1},{2,1}{2,1,1},{2,0}{1,1,-1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,0,1}},{{1,1}{1,1,0},{1,0}{2,1,-1},{2,1}{1,1,1},{2,0}{2,1,1}},{{1,1}{2,0,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}},{{1,1}{2,1,1},{1,0}{2,1,-1},{2,1}{2,1,0},{2,0}{1,1,1}}},{3,5}]

Non-Blank Initial Conditions

Multiway