Post Tag System

Max Piskunov
Woflram Research

Code

In[]:=
<<GeneralUtilities`;
In[]:=
TagSystemStep[{dropCount_, appendSequences_}][init_] :=​​ Join[Drop[init, UpTo[dropCount]], Replace[First[init], appendSequences]];
In[]:=
TagSystemList[rule_, steps_][init_] := NestList[TagSystemStep[rule], init, steps];
In[]:=
TagSystemHistoryStep[{dropCount_, appendSequences_}][{startPosition_, history_}] := {​​ startPosition + dropCount,​​ Join[history, Replace[history[[startPosition]], appendSequences]]​​};
In[]:=
TagSystemHistory[rule_, steps_][init : {startPosition_Integer, history_List}] :=​​ NestWhile[TagSystemHistoryStep[rule], init, #[[1]] ≤ Length[#[[2]]] &, 1, steps];
In[]:=
$tagSystemSimpleRulesPattern = {({_Integer, _Integer}  {_Integer, {___Integer}})..};
In[]:=
TagSystemNextGeneration[rules : $tagSystemSimpleRulesPattern][initPhase_Integer, initState : {___Integer}] :=​​ {#[[-1, 1]], Catenate[#[[All, 2]]]} & @ FoldList[With[{​​ phase = #1[[1]],​​ value = #2},​​ Replace[rules][{phase, value}]​​ ] &, {initPhase, {}}, initState];
In[]:=
TagSystemGenerations[rules : $tagSystemSimpleRulesPattern, generations_Integer][​​ initPhase_Integer, initState : {___Integer}] :=​​ FixedPointList[TagSystemNextGeneration[rules] @@ # &, {initPhase, initState}, generations]
In[]:=
postRules = {​​ (* {phase, value}  {newPhase, newValues} *)​​ {0, 0}  {1, {0}},​​ {1, 0}  {2, {0}},​​ {2, 0}  {0, {}},​​ {0, 1}  {2, {1, 1}},​​ {1, 1}  {0, {1}},​​ {2, 1}  {1, {0}}​​};
In[]:=
RecoverPhases[rules : $tagSystemSimpleRulesPattern][initPhase_, state_] :=​​ Most @ FoldList[Replace[rules][{##}][[1]] &, initPhase, state]
In[]:=
TagSystemPlot[rules_, evolution_] := ModuleScope[​​ phases = RecoverPhases[rules] @@@ evolution;​​ valuesToPlot = evolution[[All, 2]] + 2 phases;​​ ArrayPlot[​​ valuesToPlot,​​ ColorRules  value_ :> Nest[If[Mod[value, 2] === 0, Lighter, Darker], ColorData[97, Quotient[value, 2] + 1], 2]]​​]
In[]:=
AllInits[count_] := Tuples[{Range[0, 2], IntegerDigits[#, 2, count] & /@ Range[0, 2^count - 1]}]
In[]:=
TagSystemNextGeneration[postRules][0,{1,0,1,1,0,0,0,0,1,1,1}]
Out[]=
{2,{1,1,1,1,0,0,0,0,0,1,1,1}}
In[]:=
TagSystemGenerations[postRules,10000][0,{1,0,1,1,0,0,0,0,1,1,1}]
Out[]=
{{0,{1,0,1,1,0,0,0,0,1,1,1}},{2,{1,1,1,1,0,0,0,0,0,1,1,1}},{0,{0,1,1,1,0,0,0,0,1,1,0,1}},{0,{0,1,1,1,0,0,0,0,0,1,0,1}},{2,{0,1,1,1,0,0,0,0,1,1,1,1}},{0,{1,1,0,1,0,0,0,1,1,1,0,1}},{1,{1,1,0,0,0,0,0,1,1,1,0,0,0}},{1,{1,1,1,0,0,0,1,1,1,0,0,0}},{1,{1,1,1,0,0,0,1,1,1,0,0,0}}}

Rule Simplification

Introduction

First point is that thinking about the Post’s system as an ordinary Tag System would produce a computation that has redundancies.
The post system rules are
{{0,_,_,rest___}{rest,0,0},​​{1,_,_,rest___}{rest,1,1,0,1}}
Note that the system deletes three tokens at each step, however, it only looks at the first one. Therefore, 2/3 of the tokens will never even be looked at. And, we know ahead of time which ones. So, we don’t even need to store them.
Hence, we can redefine the system as follows.

New Rule

Let’s say the “head” has three states that represent the “phase”, the remainder of the length of the “old” state divided by 3.
The “new” state will then only store 1/3 of the tokens, so that the rule will only read and remove the first element.
The rules can then be rewritten as follows (the format is {oldPhase, removedToken} -> {newPhase, addedTokens}):
In[]:=
simpleRules={​​{0,0}{1,{0}},​​{1,0}{2,{0}},​​{2,0}{0,{}},​​{0,1}{2,{1,1}},​​{1,1}{0,{1}},​​{2,1}{1,{0}}​​};

Generational Updating

The evolution plots in NKS have lots of redundancy as well, because neighboring lines just repeat with only beginning and end shifted. We can instead use generational plots similar to what we do with most other systems.
We can then plot these things with “darkness” corresponding to the value of the token, and color (BOG) corresponding to the “phase” (I admit we need a better way to plot these).
Then, evolutions start to look dramatically simpler. For example, compare before and after:
In[]:=
fullRule={3,{0{0,0},1{1,1,0,1}}};
In[]:=
{TagSystemList[fullRule,5][{1}]//ArrayPlot,TagSystemPlot[postRules,TagSystemGenerations[postRules,1000000][0,{1}]]}
Out[]=

,

In[]:=
{1,1,1,0,1,1,1,1,0,1,1,0,0,0,0,0,0,1,0,1,1,0,1,1,1,0,0,1,1,0,1,0,1}〚1;;-1;;3〛
Out[]=
{1,0,1,1,0,0,0,0,1,1,1}
In[]:=
{TagSystemList[fullRule,100][{1,1,1,0,1,1,1,1,0,1,1,0,0,0,0,0,0,1,0,1,1,0,1,1,1,0,0,1,1,0,1,0,1}]//ArrayPlot,TagSystemPlot[postRules,TagSystemGenerations[postRules,1000000][0,{1,0,1,1,0,0,0,0,1,1,1}]]}

Fixed Point Result

Then, a very interesting thing happens: all of these systems not just terminate with a periodic repeat, they terminate with a fixed final state (i.e., the period is always one in terms of generations).
TagSystemGenerations function computes the generation-by-generation evolution until the fixed point, and as one can see, it always terminates early (the largest one up to init length 8*3 in 83 generations).

Next Steps

◼
  • C++ code for doing this even faster (although even WL code can generate evolutions for all inits from the NKS book in a few minutes) is in the process of development.
  • ◼
  • We need to understand why, if possible, there is always a fixed point. It would be best if we can do that analytically, as that will answer the original question. I think the next step here would be to look at all the final states we obtained and to figure out what makes them a fixed point.