Simple binary Turing machines, their numbering, behaviour and output.

Wolfram’s numbering scheme of Turing machines with s states and k characters and no explicit halting state.

Number of Turing machines with s states and k characters (binary machines are enligthed) :

Grid[MapThread[Prepend,{Prepend[Table[(2s k)^(s k),{s,2,5},{k,2,5}],{"s"->2,"s"->3,"s"->4,"s"->5}],{"","k"->2,"k"->3,"k"->4,"k"->5}}],Frame->All,Background->{None,{None,Yellow}}]

Instructions table of a machine whose rule number is given :

instructions[tmnumber_,{s_,k_}]:=Flatten[MapIndexed[{1,-1} #2+{0,k}->{1,1,2} Mod[Quotient[#1,{2 k,2,1}],{s,k,2}]+{1,0,-1}&,Partition[IntegerDigits[tmnumber,2 s k,s k],k],{2}]]

instructions[22596440,{3,4}]

Rule number of a machine whose instructions table is given :

TMNumber[instructions_,{s_,k_}]:=FromDigits[(#[[2,3]]/.-1->0)+2(#[[2,2]])+2k(#[[2,1]]-1)&/@instructions,2s k]

TMNumber[{{1,3}->{1,0,-1},{1,2}->{1,0,-1},{1,1}->{1,0,-1},{1,0}->{1,0,-1},{2,3}->{1,0,-1},{2,2}->{1,0,-1},{2,1}->{1,1,-1},{2,0}->{3,2,-1},{3,3}->{1,1,-1},{3,2}->{2,2,1},{3,1}->{3,3,-1},{3,0}->{2,0,-1}},{3,4}]

Clearly TMNumber annihilates instructions :

TMNumber[instructions[22596440,{3,4}],{3,4}]

The s×k triplets, (s,k,d), associated to a given rule, in Wolfram’s canonical order (s =1, 2, ...;k=0, 1, ...; d=-1,+1) :

Triplets[tmnumber_,{s_,k_}]:=instructions[tmnumber,{s,k}][[All,2]]

Triplets[22596440,{3,4}]

The same triplets in shifted mode (s =0, 1, ...;k=0, 1, ...; d=0,1) :

ShiftedTriplets[tmnumber_,{s_,k_}]:=Transpose[MapAt[((#+1)/2)&,MapAt[#-1&,Transpose[Triplets[tmnumber,{s,k}]],1],3]]

ShiftedTriplets[22596440,{3,4}]

Recovering the machine rule number from the shifted triplets :

TMNumberfromShiftedTriplets[ShiftedTriplets_,{s_,k_}]:=FromDigits[#[[3]]+2#[[2]]+2k#[[1]]&/@ShiftedTriplets,2s k]

TMNumberfromShiftedTriplets[{{0,0,0},{0,0,0},{0,0,0},{0,0,0},{0,0,0},{0,0,0},{0,1,0},{2,2,0},{0,1,0},{1,2,1},{2,3,0},{1,0,0}},{3,4}]

Example : running binary 2-state machine 2867 on an initially white tape :

s=2;k=2;limit=8;{Clear[tm];tm=TuringMachine[{2867 ,s,k},{{1,0},{{},0}},limit];
step=If[MemberQ[Transpose[Transpose[tm][[1]]][[3]],1],First[Position[Transpose[Transpose[tm][[1]]][[3]],1]][[1]],limit]-1;Clear[tm];tm=TuringMachine[{2867 ,s,k},{{1,0},{{},0}},step];
delta=If[1-Min[Transpose[Transpose[tm][[1]]][[3]]]>0,1-Min[Transpose[Transpose[tm][[1]]][[3]]],0];
tm12=Transpose[Transpose[tm][[1]]][[2]];tm11=Transpose[Transpose[tm][[1]]][[1]];f[2867]=ArrayPlot[Last/@tm,Mesh->True,PlotLabel->{s,k,2867},LabelStyle->Directive[Bold],Epilog->{{Red,Thick,Line[{{delta,0},{delta,step+1}}]},Orange,Thickness[0.15/(step+1)],Arrowheads[0.5/(step+1)],Table[Rotate[Arrow[{{-1/2+tm12[[i]],2/10+1+step-i},{-1/2+tm12[[i]],4/5+1+step-i}}],-2π/s(tm11[[i]]-1)],{i,step+1}]}];}

f[2867]

Running on an initially black tape reverses the black and white cells if the rule number is suitably changed (permute successive odd and even triplets and flip the character bit in each triplet) :

ShiftedTriplets[2867,{2,2}]

TMNumberfromShiftedTriplets[{{1,0,1},{1,0,0},{1,1,0},{0,1,1}},{2,2}]

TMNumberfromShiftedTriplets[{{1,1,0},{1,1,1},{0,0,1},{1,0,0}},{2,2}]

s=2;k=2;limit=8;{Clear[tm];tm=TuringMachine[{3532,s,k},{{1,1},{{},1}},limit];
step=If[MemberQ[Transpose[Transpose[tm][[1]]][[3]],1],First[Position[Transpose[Transpose[tm][[1]]][[3]],1]][[1]],limit]-1;Clear[tm];tm=TuringMachine[{3532,s,k},{{1,1},{{},1}},step];
delta=If[1-Min[Transpose[Transpose[tm][[1]]][[3]]]>0,1-Min[Transpose[Transpose[tm][[1]]][[3]]],0];
tm12=Transpose[Transpose[tm][[1]]][[2]];tm11=Transpose[Transpose[tm][[1]]][[1]];f[3532]=ArrayPlot[Last/@tm,Mesh->True,PlotLabel->{s,k,3532},LabelStyle->Directive[Bold],Epilog->{{Red,Thick,Line[{{delta,0},{delta,step+1}}]},Orange,Thickness[0.15/(step+1)],Arrowheads[0.5/(step+1)],Table[Rotate[Arrow[{{-1/2+tm12[[i]],2/10+1+step-i},{-1/2+tm12[[i]],4/5+1+step-i}}],-2π/s(tm11[[i]]-1)],{i,step+1}]}];}

f[3532]

Analysis of the 4096 2-states binary machines.

Some machines surely do not halt and may be discarded :

Example 1.  Machines that do not halt because the head moves repeatedly to the left  (in shifted mode : (σ,0)->(σ’,κ’,0)):

subset1=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{s2,k2,0},{s3,k3,d3},{s4,k4,0}},{2,2}],{s1,0,1},{s2,0,1},{s3,0,1},{s4,0,1},{k1,0,1},{k2,0,1},{k3,0,1},{k4,0,1},{d1,0,1},{d3,0,1}]]]

Length[subset1]

Example 2.   Machines that do not halt because the initial instruction is applied repeatedly (in shifted mode : (0,0)->( 0,κ,0)) :

subset2=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{0,k2,0},{s3,k3,d3},{s4,k4,d4}},{2,2}],{s1,0,1},{s3,0,1},{s4,0,1},{k1,0,1},{k2,0,1},{k3,0,1},{k4,0,1},{d1,0,1},{d3,0,1},{d4,0,1}]]]

Length[subset2]

Subsets 1 & 2 are not disjoint  :

Length[Union[subset1,subset2]]

One half (2048) of the machines halt in one step :

Example 3 : Machines that halt in one step outputing a single white cell.

subset3=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{s2,0,1},{s3,k3,d3},{s4,k4,d4}},{2,2}],{s1,0,1},{s2,0,1},{s3,0,1},{s4,0,1},{k1,0,1},{k3,0,1},{k4,0,1},{d1,0,1},{d3,0,1},{d4,0,1}]]]

Length[subset3]

Example 4 : Machines that halt in one step outputing a single black cell.

subset4=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{s2,1,1},{s3,k3,d3},{s4,k4,d4}},{2,2}],{s1,0,1},{s2,0,1},{s3,0,1},{s4,0,1},{k1,0,1},{k3,0,1},{k4,0,1},{d1,0,1},{d3,0,1},{d4,0,1}]]]

Length[subset4]

Machines belonging to the union of the previous subsets are rather trivial.  The other machines belong to the “reduced” set :

reducedset=Complement[Table[j,{j,0,4095}],Union[subset1,subset2,subset3,subset4]];

reducedset

Length[reducedset]

Evolution of the 512 “not so” trivial machines on an initially white tape :

s=2;k=2;limit=8;Do[{Clear[tm];tm=TuringMachine[{reducedset[[j]],s,k},{{1,0},{{},0}},limit];
step=If[MemberQ[Transpose[Transpose[tm][[1]]][[3]],1],First[Position[Transpose[Transpose[tm][[1]]][[3]],1]][[1]],limit]-1;Clear[tm];tm=TuringMachine[{reducedset[[j]],s,k},{{1,0},{{},0}},step];
delta=If[1-Min[Transpose[Transpose[tm][[1]]][[3]]]>0,1-Min[Transpose[Transpose[tm][[1]]][[3]]],0];
tm12=Transpose[Transpose[tm][[1]]][[2]];tm11=Transpose[Transpose[tm][[1]]][[1]];f[reducedset[[j]]]=ArrayPlot[Last/@tm,Mesh->True,PlotLabel->{s,k,reducedset[[j]]},LabelStyle->Directive[Bold],Epilog->{{Red,Thick,Line[{{delta,0},{delta,step+1}}]},Orange,Thickness[0.15/(step+1)],Arrowheads[0.5/(step+1)],Table[Rotate[Arrow[{{-1/2+tm12[[i]],2/10+1+step-i},{-1/2+tm12[[i]],4/5+1+step-i}}],-2π/s(tm11[[i]]-1)],{i,step+1}]}]},{j,512}]

GraphicsGrid[Partition[Table[Show[f[reducedset[[j]]]],{j,512}],16]]

Observe that the busiest machines output 111 in 7 steps (Rule numbers, 423, 935, 1447, 1959, 2439, 2471, 2983, 3495, 3891, 4007) or 101 in 7 steps too (Rule number, 2867).

Output inventory of the halting 2-states binary machines.

Mathematica preliminaries :

SingleTMStep[rule_, {s_, tape_, pos_} /; pos<1] := {s, tape, pos}

SingleTMStep[rule_, {s_, tape_, pos_} /; pos>Length[tape]] := SingleTMStep[rule,{s, Prepend[tape,0], pos}]

SingleTMStep[rule_, {s_, tape_, pos_}] := Apply[{#1,ReplacePart[tape,#2,-pos],pos-#3}&,Replace[{s,tape[[-pos]]},rule]]

SingleTMEvolve[rule_, tape_, bound___] := NestWhile[SingleTMStep[rule, #]&, {1,tape,1}, (#[[3]]>0)&,1,bound]

SingleTMEvolveList[rule_, tape_, bound___] := NestWhileList[SingleTMStep[rule, #]&, {1,tape,1}, (#[[3]]>0)&,1,bound]

One only runs the 512 machines from the reduced set and, after that, one reintroduces the discarded one-step halting machines :

Timing[result={};Do[{z=SingleTMEvolveList[instructions[reducedset[[j]],{2,2}],{0},8], If[Length[z]≤8,result=Append[result,Last[z][[2]]],]},{j,1,512}]]

Tally[result]

resu=Prepend[Prepend[Tally[result],{{1},1024}],{{0},1024}]

Grid[resu]

The output has been read from left to rigth but it may equally well be read from rigth to left :

symrev=SortBy[Join[resu,{Reverse[#1[[1]]],#[[2]]}&/@resu],#[[1]]&]

le=Length[Union[Transpose[symrev][[1]]]];Do[If[symrev[[i,1]]==symrev[[i+1,1]],{symrev[[i,2]]=symrev[[i,2]]+symrev[[i+1,2]],symrev=Delete[symrev,i+1]},],{i,le}]

symrev

The tape may equally well be initially completely black :

symrevinv=Sort[Sort[Join[symrev,Transpose[{Transpose[symrev][[1]]/.{0->u,1->v}/.{u->1,v->0},Transpose[symrev][[2]]}]],Length[#1[[1]]]<Length[#2[[1]]]&]]

la=Length[Union[Transpose[symrevinv][[1]]]]-1;Do[If[symrevinv[[i,1]]==symrevinv[[i+1,1]],{symrevinv[[i,2]]=symrevinv[[i,2]]+symrevinv[[i+1,2]],symrevinv=Delete[symrevinv,i+1]},],{i,la}]

symrevinv

Total[Transpose[symrevinv][[2]]]

symrevinvnorm=Transpose[{Transpose[symrevinv][[1]],((Transpose[symrevinv][[2]])/9388.)}]

{Grid[SortBy[resu,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink],Grid[SortBy[symrev,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink],Grid[SortBy[symrevinv,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink],Grid[SortBy[symrevinvnorm,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink]}

From left to rigth : halting 2-states machines 1) on a white tape, output read from left to rigth  2) on a white tape, output read in both directions  3) and 4) on a white or black tape, output read in both directions (completely symmetrical under 0-1 and rigth-left inversions).

Analysis of the 2985984 3-states binary machines.

Some machines surely do not halt and may be discarded :

Example 1.  Machines that do not halt because the head moves repeatedly to the left  (in shifted mode : (σ,0)->(σ’,κ’,0)):

subset1=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{s2,k2,0},{s3,k3,d3},{s4,k4,0},{s5,k5,d5},{s6,k6,0}},{3,2}],{s1,0,2},{s2,0,2},{s3,0,2},{s4,0,2},{s5,0,2},{s6,0,2},{k1,0,1},{k2,0,1},{k3,0,1},{k4,0,1},{k5,0,1},{k6,0,1},{d1,0,1},{d3,0,1},{d5,0,1}]]];

Length[subset1]

Example 2.   Machines that do not halt because the initial instruction is applied repeatedly (in shifted mode : (0,0)->( 0,κ,0)) :

subset2=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{0,k2,0},{s3,k3,d3},{s4,k4,d4},{s5,k5,d5},{s6,k6,d6}},{3,2}],{s1,0,2},{s3,0,2},{s4,0,2},{s5,0,2},{s6,0,2},{k1,0,1},{k2,0,1},{k3,0,1},{k4,0,1},{k5,0,1},{k6,0,1},{d1,0,1},{d3,0,1},{d4,0,1},{d5,0,1},{d6,0,1}]]];

Length[subset2]

Example 3.   Machines that do not halt because they execute repeatedly a specific pair of instructions (in shifted mode : (0,0)->( 1,κ,0) and  (1,0)->( σ’,κ’,0) :

subset3=Sort[Flatten[Union[    
Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{1,k2,0},{s3,k3,d3},{s4,k4,0},{s5,k5,d5},{s6,k6,d6}},{3,2}],{s1,0,2},{s3,0,2},{s4,0,1},{s5,0,2},{s6,0,2},{k1,0,1},{k2,0,1},{k3,0,1},{k4,0,1},{k5,0,1},{k6,0,1},{d1,0,1},{d3,0,1},{d5,0,1},{d6,0,1}], 

Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{2,k2,0},{s3,k3,d3},{s4,k4,d4},{s5,k5,d5},{s6,k6,0}},{3,2}],{s1,0,2},{s3,0,2},{s4,0,2},{s5,0,2},{s6,0,2,2},{k1,0,1},{k2,0,1},{k3,0,1},{k4,0,1},{k5,0,1},{k6,0,1},{d1,0,1},{d3,0,1},{d4,0,1},{d5,0,1}]  ]]];

Length[subset3]

Example 4 : Machines that halt in one step outputing a single white cell.

subset4=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{s2,0,1},{s3,k3,d3},{s4,k4,d4},{s5,k5,d5},{s6,k6,d6}},{3,2}],{s1,0,2},{s2,0,2},{s3,0,2},{s4,0,2},{s5,0,2},{s6,0,2},{k1,0,1},{k3,0,1},{k4,0,1},{k5,0,1},{k6,0,1},{d1,0,1},{d3,0,1},{d4,0,1},{d5,0,1},{d6,0,1}]]];

Length[subset4]

Example 5 : Machines that halt in one step outputing a single black cell.

subset5=Sort[Flatten[Table[TMNumberfromShiftedTriplets[{{s1,k1,d1},{s2,1,1},{s3,k3,d3},{s4,k4,d4},{s5,k5,d5},{s6,k6,d6}},{3,2}],{s1,0,2},{s2,0,2},{s3,0,2},{s4,0,2},{s5,0,2},{s6,0,2},{k1,0,1},{k3,0,1},{k4,0,1},{k5,0,1},{k6,0,1},{d1,0,1},{d3,0,1},{d4,0,1},{d5,0,1},{d6,0,1}]]];

Length[subset5]

Machines belonging to the union of the previous subsets are rather trivial.  The other machines belong to the “reduced” set :

reducedset=Complement[Table[j,{j,0,2985983}],Union[subset1,subset2,subset3,subset4,subset5]];

Length[reducedset]

The busiest 3-states machines halt in 25 steps :

BB3={};Timing[u=Do[{z=SingleTMEvolveList[instructions[reducedset[[j]],{3,2}],{0},26], If[Length[z]==26,BB3=Append[BB3,reducedset[[j]]],]},{j,1,580608}]]

BB3

Length[BB3]

s=3;k=2;limit=26;Do[{Clear[tm];tm=TuringMachine[{BB3[[j]],s,k},{{1,0},{{},0}},limit];
step=If[MemberQ[Transpose[Transpose[tm][[1]]][[3]],1],First[Position[Transpose[Transpose[tm][[1]]][[3]],1]][[1]],limit]-1;Clear[tm];tm=TuringMachine[{BB3[[j]],s,k},{{1,0},{{},0}},step];
delta=If[1-Min[Transpose[Transpose[tm][[1]]][[3]]]>0,1-Min[Transpose[Transpose[tm][[1]]][[3]]],0];
tm12=Transpose[Transpose[tm][[1]]][[2]];tm11=Transpose[Transpose[tm][[1]]][[1]];f[BB3[[j]]]=ArrayPlot[Last/@tm,Mesh->True,PlotLabel->{s,k,BB3[[j]]},LabelStyle->Directive[Bold],Epilog->{{Red,Thick,Line[{{delta,0},{delta,step+1}}]},Orange,Thickness[0.15/(step+1)],Arrowheads[0.5/(step+1)],Table[Rotate[Arrow[{{-1/2+tm12[[i]],2/10+1+step-i},{-1/2+tm12[[i]],4/5+1+step-i}}],-2π/s(tm11[[i]]-1)],{i,step+1}]}]},{j,8}]

GraphicsGrid[Partition[Table[Show[f[BB3[[j]]]],{j,8}],8]]

Two most productive machine are among the busiest.

Output inventory of the halting 3-states binary machines.

One only runs the 580608 machines from the reduced set and, after that, one reintroduces the discarded one-step halting machines :

Timing[result={};Do[{z=SingleTMEvolveList[instructions[reducedset[[j]],{3,2}],{0},26], If[Length[z]≤26,result=Append[result,Last[z][[2]]],]},{j,580608}]]

Length[result]

resu=Prepend[Prepend[Tally[result],{{1},746496}],{{0},746496}]

Grid[resu]

The output has been read from left to rigth but it may equally well be read from rigth to left :

symrev=SortBy[Join[resu,{Reverse[#1[[1]]],#[[2]]}&/@resu],#[[1]]&]

le=Length[Union[Transpose[symrev][[1]]]];Do[If[symrev[[i,1]]==symrev[[i+1,1]],{symrev[[i,2]]=symrev[[i,2]]+symrev[[i+1,2]],symrev=Delete[symrev,i+1]},],{i,le}]

symrev

The tape may equally well be initially completely black :

symrevinv=Sort[Sort[Join[symrev,Transpose[{Transpose[symrev][[1]]/.{0->u,1->v}/.{u->1,v->0},Transpose[symrev][[2]]}]],Length[#1[[1]]]<Length[#2[[1]]]&]]

la=Length[Union[Transpose[symrevinv][[1]]]]-1;Do[If[symrevinv[[i,1]]==symrevinv[[i+1,1]],{symrevinv[[i,2]]=symrevinv[[i,2]]+symrevinv[[i+1,2]],symrevinv=Delete[symrevinv,i+1]},],{i,la}]

symrevinv

Total[Transpose[symrevinv][[2]]]

symrevinvnorm=Transpose[{Transpose[symrevinv][[1]],((Transpose[symrevinv][[2]])/7302568.)}]

{Grid[SortBy[resu,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink],Grid[SortBy[symrev,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink],Grid[SortBy[symrevinv,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink],Grid[SortBy[symrevinvnorm,-#[[2]]&],Frame->All,ItemStyle->Bold,Background->LightPink]}

From left to rigth : halting 3-states machines 1) on a white tape, output read from left to rigth  2) on a white tape, output read in both directions  3) and 4) on a white or black tape, output read in both directions (completely symmetrical under 0-1 and rigth-left inversions).