Tag Systems States Graph

In[]:=

<< GeneralUtilities`;

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[]:=

PostTagSystemNext[state : PostState[_, {}]] := {}

In[]:=

PostTagSystemNext[PostState[phase_, state_]] := ModuleScope[ {newPhase, newTokens} = Replace[postRules][{phase, First[state]}]; PostState[newPhase, Join[Rest[state], newTokens]]]

In[]:=

AllInits[count_] := PostState @@@ Tuples[{Range[0, 2], IntegerDigits[#, 2, count] & /@ Range[0, 2^count - 1]}]

In[]:=

AllInits[min_ ;; max_] := Catenate[AllInits /@ Range[min, max]]

In[]:=

?NestWhile

Out[]=

Symbol
NestWhile[f,expr,test] starts with expr, then repeatedly applies f until applying test to the result no longer yields True. NestWhile[f,expr,test,m] supplies the most recent m results as arguments for test at each step. NestWhile[f,expr,test,All] supplies all results so far as arguments for test at each step. NestWhile[f,expr,test,m,max] applies f at most max times. NestWhile[f,expr,test,m,max,n] applies f an extra n times. NestWhile[f,expr,test,m,max,-n] returns the result found when f had been applied n fewer times.

NestWhile[]

In[]:=

NestGraph[PostTagSystemNext,{PostState[0,{0,0,0}],PostState[1,{1,1,1}]},1000,VertexLabels(PostState[phase_,state_]Replace[phase,{0"0",1"1",2"2"}]<>StringJoin[Replace[state,{0"",1"■"},1]]),VertexStyle{PostState[phase_,state_/;Length[state]>sizeLimit]Directive[Red,Large]}(*VertexSize{PostState[phase_,state_/;(Length[state]>sizeLimit||Length[state]0)]1.5}*)]

Out[]=

WolframModel[<|"PatternRules"{{left_,h0},{h0,right_},{right_,0},{right_,farRight_}}Module[{newLeft},{{left,newLeft},{newLeft,0},{newLeft,h1},{h1,farRight}}]|>]

In[]:=

With[{sizeLimit=10},NestGraph[PostTagSystemNext,AllInits[0;;sizeLimit],1,VertexLabelsNone,VertexLabels(PostState[phase_,state_]Replace[phase,{0"0",1"1",2"2"}]<>StringJoin[Replace[state,{0"",1"■"},1]]),VertexStyle{PostState[phase_,state_/;Length[state]>sizeLimit]Directive[Red,Large]}(*VertexSize{PostState[phase_,state_/;(Length[state]>sizeLimit||Length[state]0)]1.5}*)]]

Out[]=

In[]:=

With[{sizeLimit=∞},NestGraph[PostTagSystemNext,PostState[0,Append[ConstantArray[0,12],1]],10000,VertexLabels(PostState[phase_,state_]Placed[Replace[phase,{0"0",1"1",2"2"}]<>StringJoin[Replace[state,{0"",1"■"},1]],Tooltip]),VertexStyle{PostState[phase_,state_/;Length[state]>sizeLimit]Directive[Red,Large]}(*VertexSize{PostState[phase_,state_/;(Length[state]>sizeLimit||Length[state]0)]1.5}*)]]

Out[]=