Input: list of rules
Output: terminal step (if found), total number of states
In[]:=
compiledWL$FindTuringMachineLifetime = FunctionCompile[Function[​​ (* rule is specified as oldHeadState, oldCellState, newHeadState, newCellState, motionDirection *)​​ {Typed[rules, TypeSpecifier["PackedArray"]["MachineInteger", 2]],​​ Typed[maxEvents, "MachineInteger"],​​ Typed[maxStates, "MachineInteger"]}, Module[{​​ $oldHeadState = 1, $oldCellState = 2, $newHeadState = 3, $newCellState = 4, $motionDirection = 5,​​ $headPosition = -2, $headState = -1,​​ $terminated = 1, $maxEventsExceeded = 2, $maxStatesExceeded = 3,​​ turingMachineStepForRule, turingMachineSteps,​​ initState, result = {0, 0, 0}, set, catenate3to2, union,​​ allStates, currentStates, event},​​ initState = Join[Table[0, 2 maxEvents + 1], {maxEvents + 1, 1}];​​ turingMachineStepForRule = Function[{rule, state}, Module[{newState},​​ If[rule[[$oldHeadState]] == state[[$headState]] && rule[[$oldCellState]] == state[[state[[$headPosition]]]],​​ newState = state;​​ newState[[state[[$headPosition]]]] = rule[[$newCellState]];​​ newState[[$headPosition]] = state[[$headPosition]] + rule[[$motionDirection]];​​ newState[[$headState]] = rule[[$newHeadState]];​​ newState​​ ,​​ ConstantArray[-1, Length[state]]​​ ]​​ ]];​​ turingMachineSteps = Function[{state},​​ turingMachineStepForRule[#, state] & /@ rules​​ ];​​ catenate3to2 = Function[{listOfListsOfLists}, Module[{catenateResult = listOfListsOfLists[[1]], i, j},​​ If[Length[listOfListsOfLists]  0,​​ Rest[{{0}}] (* emptyList *)​​ ,​​ (* This does not work: Map[AppendTo[catenateResult, #] &, Rest[listOfListsOfLists], {2}]; *)​​ For[i = 2, i ≤ Length[listOfListsOfLists], ++i,​​ (* This does not work either: Scan[AppendTo[catenateResult, #] &, listOfListsOfLists[[i]]]; *)​​ For[j = 1, j ≤ Length[listOfListsOfLists[[i]]], ++j,​​ AppendTo[catenateResult, listOfListsOfLists[[i, j]]];​​ ];​​ ];​​ catenateResult​​ ]​​ ]];​​ union = Function[{list}, Module[{sortedList, pairs, unionResult, i},​​ sortedList = Sort[list];​​ pairs = Partition[sortedList, 2, 1];​​ unionResult = {First[sortedList]};​​ (* Scan over AppendTo does not work here as well.​​ I could not make any of the selecting functions (Select, Union, DeleteDuplicates, Cases) to work as well. *)​​ For[i = 1, i ≤ Length[pairs], ++i,​​ If[pairs[[i, 1]] =!= pairs[[i, 2]],​​ AppendTo[unionResult, pairs[[i, 2]]];​​ ];​​ ];​​ unionResult​​ ]];​​ allStates = {initState};​​ currentStates = {initState};​​ For[event = 1, True, ++event, Module[{previousAllStatesLength},​​ currentStates = union[catenate3to2[turingMachineSteps /@ currentStates]];​​ previousAllStatesLength = Length[allStates];​​ allStates = union[Join[allStates, currentStates]];​​ If[Length[allStates]  previousAllStatesLength,​​ result = {$terminated, Length[allStates], event};​​ Break[];​​ ];​​ If[Length[allStates] > maxStates,​​ result = {$maxStatesExceeded, Length[allStates], event};​​ Break[];​​ ];​​ If[event  maxEvents,​​ result = {$maxEventsExceeded, Length[allStates], event};​​ Break[];​​ ];​​ ]];​​ result​​]]];
In[]:=
FindTuringMachineLifetime[rules_, maxEvents_, maxCurrentStates_] := Module[{compiledResult, metadataAssocation},​​ compiledResult = compiledWL$FindTuringMachineLifetime[Catenate /@ List @@@ rules, maxEvents, maxCurrentStates];​​ metadataAssocation = <|"TotalStateCount"  compiledResult[[2]], "MaxEventCount"  compiledResult[[3]]|>;​​ Switch[compiledResult[[1]],​​ 1, metadataAssocation,​​ 2, Failure["MaxEventsExceeded", metadataAssocation],​​ 3, Failure["MaxStatesExceeded", metadataAssocation] ​​ ]​​];​​SyntaxInformation[FindTuringMachineLifetime] = {"ArgumentsPattern"  {rules_, maxEvents_, maxCurrentStates_}};
Due to lack of hashing, we need to do a “manual” union. Currently, it’s done by sorting and deleting duplicates. Sorting requires
nlogn
comparisons. However, because the states themselves are length
n
, each comparison is
(n)
. So, the sorting is
2
n
logn
. We do
n
events, so the total time is
3
n
logn
. So, the time is expected.
In order to eliminate the sorting, we need to hash the elements. However, without occasional direct comparisons, we might run into hash collisions (which is why std::unordered_set takes a comparator struct as a template argument).
In[]:=
3
400
Log[400] // N
Out[]=
3.83454×
8
10
In[]:=
AbsoluteTiming[FindTuringMachineLifetime[{{1, 0}  {1, 0, 1}}, 400, 1000]]
Out[]=
6.12692,Failure

TotalStateCount: 401
MaxEventCount: 400
Tag: MaxEventsExceeded

In[]:=
AbsoluteTiming[FindTuringMachineLifetime[{{1, 0}  {1, 0, 1}}, 400, 1000]]
Out[]=
0.160871,Failure

TotalStateCount: 401
MaxEventCount: 400
Tag: MaxEventsExceeded

In[]:=
Log2[800.]
Out[]=
9.64386
800 800 Log[800.]
Out[]=
640000
800
In[]:=
Catenate /@ List @@@ {{1, 1}  {1, 1, 1}, {1, 0}  {1, 0, 1}, {2, 0}  {2, 1, -1}}
Out[]=
{{1,1,1,1,1},{1,0,1,0,1},{2,0,2,1,-1}}
In[]:=
compiledWL$FindTuringMachineLifetime[{{1, 0, 2, 0, 1}, {2, 0, 1, 0, -1}}, 4, 10000]
Out[]=
{1,3,2}
In[]:=
{1, 2, 3} ≠ {1, 2, 3}
Out[]=
False
In[]:=
? ArrayReshape
In[]:=
? TuringMachine
Out[]=
Symbol
TuringMachine[rule,init,t] generates a list representing the evolution of the Turing machine with the specified rule from initial condition init for t steps. ​TuringMachine[rule,init] gives the result of evolving init for one step. ​TuringMachine[rule] is an operator form of TuringMachine that corresponds to one step of evolution.