Universal Turing Machine

Author

Eric W. Weisstein
April 16, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalSystems/UniversalTuringMachine.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/UniversalTuringMachine.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Based on ideas in Stephen Wolfram's A New Kind of Science

Figures adapted from Stephen Wolfram's A New Kind of Science

Legacy documentation for NKSExplorer package available at https://reference.wolfram.com/legacy/applications/nksx/

Code

TuringPartition[t_,n_]:=Module[{g=First/@t[[1]],h},
h=Ceiling[Length[g]/n];
{
g/.Rectangle[{x1_,0},{x2_,1},r_]:>Rectangle[{Mod[x1,n],-.5Floor[(x2-1)/n]},{Mod[x1,n]+1,-.5Floor[(x2-1)/n]-.5},r],
Table[Line[{{0,-.5i},{n,-.5i}}],{i,0,h}],
Table[Line[{{i,0},{i,-.5h}}],{i,0,n}]
}
]

TuringMachine[7,4]:=NKSExplorer`TuringMachines`ElementaryTuringGraphic[{{1,0}->{1,2,1},{1,1}->{1,3,1},{1,2}->{2,0,-1},{1,3}->{5,2,-1},{2,0}->{2,0,-1},{2,1}->{1,3,1},{2,2}->{2,0,-1},{2,3}->{2,1,-1},{3,0}->{5,2,-1},{3,1}->{3,3,1},{3,2}->{3,2,1},{3,3}->{3,1,1},{4,0}->{5,3,-1},{4,1}->{4,3,1},{4,2}->{4,2,1},{4,3}->{4,1,1},{5,0}->{5,0,0},{5,1}->{5,3,-1},{5,2}->{5,2,-1},{5,3}->{6,1,-1},{6,0}->{3,2,1},{6,1}->{7,1,-1},{6,2}->{6,2,-1},{6,3}->{6,1,-1},{7,0}->{4,2,1},{7,1}->{7,1,1},{7,2}->{7,0,1},{7,3}->{1,0,1}},4];

TuringMachine[2,5]:=NKSGraphics[78.1,{{{1,4}->{2,3,-1},{1,3}->{2,4,1},{1,2}->{1,0,1},{1,1}->{1,0,1},{1,0}->{1,1,-1},{2,4}->{2,2,-1},{2,3}->{2,4,1},{2,2}->{1,4,1},{2,1}->{1,0,1},{2,0}->{1,3,-1}}}][[1]]

7-state, 4-color

Show[Graphics[TuringPartition[TuringMachine[7,4][[1]],7]]]

2-state, 5-color

Show[Graphics[TuringPartition[TuringMachine[2,5],5]],AspectRatio->.4]

Show[NKSGraphics[707.1]]

2-state, 4-color candidates

Show[GraphicsArray[{NKSGraphics[708.1,#]}&/@NKSExamples[708.1]
]]

2-state, 3-color candidate

Show[NKSGraphics[709.1]]