NKS PostTagSystem Evaluator

Rough prototype. It’s not recommended to use for anything other than testing.

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


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

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}