NKS PostTagSystem Evaluator
NKS PostTagSystem Evaluator
Rough prototype. It’s not recommended to use for anything other than testing.
Simple case (incomplete outputs)
Simple case (incomplete outputs)
In[]:=
nksToActiveState[nksState_] := {Mod[Length[nksState], 3], nksState[[1 ;; -1 ;; 3]]}
In[]:=
riffle[list : {_}, riffledElement_] := list
In[]:=
riffle[list_, riffledElement_] := Riffle[list, riffledElement]
In[]:=
activeToNKSState[{phase_, activeTape_}] := Join[Catenate[riffle[List /@ activeTape, {{_, _}}]], ConstantArray[_, Mod[phase - 1, 3]]]
In[]:=
activeToNKSState[{0, {}}] := {}
In[]:=
Needs["PostTagSystem`"];NKSTagSystemEvaluateSimple[nksState_, eventCount_] := activeToNKSState @ PostTagSystemFinalState[nksToActiveState @ nksState, eventCount]
In[]:=
NKSTagSystemEvaluateSimple[{1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0}, 128]
Out[]=
{1,_,_,0,_,_,1,_,_,0,_,_,0,_,_,0,_,_,0,_,_,0,_,_,1,_,_,1,_,_,1,_,_,0,_,_,0,_,_,0,_,_,1,_,_,1,_,_,1,_,_,0,_,_,1,_,_}
Test
Test
Complex case (complete outputs)
Complex case (complete outputs)
In[]:=
nksToActiveState[nksState_] := {Mod[Length[nksState], 3], nksState[[1 ;; -1 ;; 3]]}
In[]:=
riffle[list : {_}, riffledElement_] := list
In[]:=
riffle[list_, riffledElement_] := Riffle[list, riffledElement]
In[]:=
activeToNKSState[{phase_, activeTape_}] := Join[Catenate[riffle[List /@ activeTape, {{_, _}}]], ConstantArray[_, Mod[phase - 1, 3]]]
In[]:=
slowEvaluateNKSStateStep[nksTape : {_, _, __}] := Join[Drop[nksTape, 3], {{0, 0}, {1, 1, 0, 1}}[[First[nksTape] + 1]]]
In[]:=
slowEvaluateNKSStateStep[terminatedTape : {} | {_} | {_, _}] := terminatedTape
In[]:=
slowEvaluateNKSState[nksTape_, eventCount_] := Nest[slowEvaluateNKSStateStep, nksTape, eventCount]
In[]:=
Needs["PostTagSystem`"];NKSTagSystemEvaluate[nksState_, eventCount_] := Module[{ initState, evaluationResult, eventsDone, finalState, eventsAfterRollback, rolledBackFinalNKSState}, initState = nksToActiveState @ nksState; evaluationResult = GeneratePostTagSystemHistory[initState, Floor[eventCount, 8]]; eventsDone = evaluationResult["EventCount"]; finalState = evaluationResult["FinalState"]; eventsAfterRollback = Floor[Max[eventsDone - 2 Length[Last[finalState]], 0], 8]; rolledBackFinalNKSState = If[eventsAfterRollback == 0, nksState , activeToNKSState @ PostTagSystemFinalState[initState, eventsAfterRollback] ]; slowEvaluateNKSState[rolledBackFinalNKSState, eventCount - eventsAfterRollback]]
Warning: This kind of case will be very slow, because it starts using the slow evolution function right away.
In[]:=
NKSTagSystemEvaluate[{1, 0, 0}, 1000000]
Out[]=
{1,0,1,0,0}
In[]:=
NKSTagSystemEvaluate[{1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0}, 128]
Out[]=
{1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1}
In[]:=
NKSTagSystemEvaluate[{1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0}, 129]
Out[]=
{0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1}
Test
Test
In[]:=
And @@ ( Replace[NKSTagSystemEvaluate[#, 100] slowEvaluateNKSState[#, 100], False (Echo[#]; False)] & /@ Table[RandomInteger[1, 100], 1000])
Out[]=
True
In[]:=
And @@ ( Replace[NKSTagSystemEvaluate[#, 200] slowEvaluateNKSState[#, 200], False (Echo[#]; False)] & /@ Table[RandomInteger[1, 100], 1000])
Out[]=
True
In[]:=
And @@ ( Replace[NKSTagSystemEvaluate[#, 400] slowEvaluateNKSState[#, 400], False (Echo[#]; False)] & /@ Table[RandomInteger[1, 10], 1000])
Out[]=
True
In[]:=
EchoFunction[Length] @ NKSTagSystemEvaluate[ {0,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,0,_,_,1,_,_,1,_,_,0,_,_,1,_,_,0,_,_}, 20858064]
»
5
Out[]=
{0,0,0,0,0}
In[]:=
Column[ NKSTagSystemEvaluate[ {0,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,1,_,_,0,_,_,1,_,_,1,_,_,0,_,_,1,_,_,0,_,_}, #] & /@ Range[20858030, 20858070]]
Out[]=
{1,0,1,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1} |
{0,0,0,0,0,0,0,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0} |
{0,0,0,0,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0} |
{0,1,1,0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0} |
{0,1,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0} |
{0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0} |
{0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0,0} |
{0,0,0,0,0,0,0} |
{0,0,0,0,0,0} |
{0,0,0,0,0} |
{0,0,0,0} |
{0,0,0} |
{0,0} |
{0,0} |
{0,0} |
{0,0} |