Post Tag System
Post Tag System
Max Piskunov
Woflram Research
Code
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
Rule Simplification
Introduction
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
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
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
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
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.