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 comparisons. However, because the states themselves are length , each comparison is . So, the sorting is logn. We do events, so the total time is logn. So, the time is expected.
nlogn
n
(n)
2
n
n
3
n
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
Out[]=
3.83454×
8
10
In[]:=
AbsoluteTiming[FindTuringMachineLifetime[{{1, 0} {1, 0, 1}}, 400, 1000]]
Out[]=
6.12692,Failure
In[]:=
AbsoluteTiming[FindTuringMachineLifetime[{{1, 0} {1, 0, 1}}, 400, 1000]]
Out[]=
0.160871,Failure
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[]=