WOLFRAM NOTEBOOK

Canonical Turing Machines

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}]]
Out[]=
In[]:=
ss0[{s1_,k1_}{s2_,k2_,o_}]:={s1/.{12,21},k1}{s2/.{12,21},k2,o}
In[]:=
o0[{s1_,k1_}{s2_,k2_,o_}]:={s1,k1}{s2,k2,-o}
In[]:=
cf[{s1_,k1_}{s2_,k2_,o_}]:={s1,k1}{s2,1-k2,o}
In[]:=
minrule[r_]:=First[Sort[Sort/@{r,ss0/@r,o0/@r,ss0/@o0/@r}]]
In[]:=
minrule[r_]:=First[Sort[Sort/@{r,ss0/@r,o0/@r,ss0/@o0/@r,cf/@r,ss0/@cf/@r,o0/@cf/@r,ss0/@cf/@o0/@r}]]
In[]:=
Union[minrule/@allrules]
Out[]=
In[]:=
Length[%]
Out[]=
544
In[]:=
RulePlot[TuringMachine[#],{{1,10},Table[0,21]},9,ImageSize60,FrameStyleLightGray]&/@%154
Out[]=
In[]:=
1320
Out[]=
260
In[]:=
RulePlot[TuringMachine[#],{{1,10},Table[0,21]},9,ImageSize120,FrameStyleLightGray]&/@Range[280,280+100]
Out[]=
Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.