The Basic Setup

In[]:=
NestList[Replace[#,{{0,_,_,s___}{s,0,0},{1,_,_,s___}{s,1,1,0,1}}]&,{1,1,1,1,1},20]
Out[]=
{{1,1,1,1,1},{1,1,1,1,0,1},{1,0,1,1,1,0,1},{1,1,0,1,1,1,0,1},{1,1,1,0,1,1,1,0,1},{0,1,1,1,0,1,1,1,0,1},{1,0,1,1,1,0,1,0,0},{1,1,0,1,0,0,1,1,0,1},{1,0,0,1,1,0,1,1,1,0,1},{1,1,0,1,1,1,0,1,1,1,0,1},{1,1,1,0,1,1,1,0,1,1,1,0,1},{0,1,1,1,0,1,1,1,0,1,1,1,0,1},{1,0,1,1,1,0,1,1,1,0,1,0,0},{1,1,0,1,1,1,0,1,0,0,1,1,0,1},{1,1,1,0,1,0,0,1,1,0,1,1,1,0,1},{0,1,0,0,1,1,0,1,1,1,0,1,1,1,0,1},{0,1,1,0,1,1,1,0,1,1,1,0,1,0,0},{0,1,1,1,0,1,1,1,0,1,0,0,0,0},{1,0,1,1,1,0,1,0,0,0,0,0,0},{1,1,0,1,0,0,0,0,0,0,1,1,0,1},{1,0,0,0,0,0,0,1,1,0,1,1,1,0,1}}
Also implement with queue.... Do[If[q[“Length”]≥3,Scan[q[“Push”,#]&,If[q[“Pop”]0,{0,0},{1,1,0,1}]];Do[q[“Pop”],2]],t]
Only every 3rd value matters ... though the phase at the end matters....
In[]:=
NestList[Join[Drop[#,3],{{0,0},{1,1,0,1}}[[1+First[#]]]]&,{0,_,_,1,_,_,1,_,_,1,_,_,1,_,_},10]
Out[]=
{{0,_,_,1,_,_,1,_,_,1,_,_,1,_,_},{1,_,_,1,_,_,1,_,_,1,_,_,0,0},{1,_,_,1,_,_,1,_,_,0,0,1,1,0,1},{1,_,_,1,_,_,0,0,1,1,0,1,1,1,0,1},{1,_,_,0,0,1,1,0,1,1,1,0,1,1,1,0,1},{0,0,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1},{1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,0,0},{1,1,0,1,1,1,0,1,1,1,0,1,0,0,1,1,0,1},{1,1,1,0,1,1,1,0,1,0,0,1,1,0,1,1,1,0,1},{0,1,1,1,0,1,0,0,1,1,0,1,1,1,0,1,1,1,0,1},{1,0,1,0,0,1,1,0,1,1,1,0,1,1,1,0,1,0,0}}
Trivial termination:
In[]:=
TSDirectEvolveList[{0,0,0},100]
Out[]=
{{0,0,0},{0,0}}
Min 2-cycle
In[]:=
TSDirectEvolveList[{1,0,0},10]
Out[]=
{{1,0,0},{1,1,0,1},{1,1,1,0,1},{0,1,1,1,0,1},{1,0,1,0,0},{0,0,1,1,0,1},{1,0,1,0,0},{0,0,1,1,0,1},{1,0,1,0,0},{0,0,1,1,0,1},{1,0,1,0,0}}

Max’s explanation

Let’s start with an NKS format for the Tag System state:
Out[]=
{1,0,1,0,0,1,1,1,0,0,0}
Note that because the rules read 3 elements at a time, but only depend on the first element, not all of the elements above are active. In the following, active elements are colored red:
Out[]=
{1,0,1,0,0,1,1,1,0,0,0}
Hence, we get the tape of the compressed state:
Out[]=
{1,0,1,0}
That describes completely the elements that will be read (rather than skipped) by the system. However, it does not give us enough information about which just created elements will be active. Consider three different ways uncompressed {1, 1, 0, 1} can be appended to the compressed state above:
Out[]=
{1,_,_,0,_,_,1,_,_,0,1,1,0,1}
{1,_,_,0,_,_,1,_,_,0,_,1,1,0,1}
{1,_,_,0,_,_,1,_,_,0,_,_,1,1,0,1}
In other words, in order to apply the tag system rule, we need to know Mod[Length[nksState], 3], which is called phase.
Out[]=
{1,0,1,0,0,1,1,1,0,

phase = 0
}
{1,0,1,0,0,1,1,1,0,
0

phase = 1
}
{1,0,1,0,0,1,1,1,0,
0,0
phase = 2
}
Hence, we now have the conversion function:
In[]:=
nksToActiveState[nksState_] := {Mod[Length[nksState], 3], nksState[[1 ;; -1 ;; 3]]}
In[]:=
nksToActiveState[{1, 0, 1, 0, 0, 1, 1, 1, 0, 0, 0}]
Out[]=
{2,{1,0,1,0}}
And also the reverse:
In[]:=
riffle[list : {_}, riffledElement_] := list;​​riffle[list_, riffledElement_] := Riffle[list, riffledElement];​​activeToNKSState[{phase_, activeTape_}] :=​​ Join[Catenate[riffle[List /@ activeTape, {{_, _}}]], ConstantArray[_, Mod[phase - 1, 3]]];​​activeToNKSState[{0, {}}] := {};
In[]:=
activeToNKSState[{2, {1, 0, 1, 0}}]
Out[]=
{1,_,_,0,_,_,1,_,_,0,_}

Phase representation

{phase,state}
The sequence is of length n, with Quotient[n, 3] blocks whose first elements will be sampled, together with p elements that will not be sampled, but which define how new elements will be appended.
In[]:=
ToSWPhaseForm[{1,0,1,0,1,1,1}]
Out[]=
{1,{1,0,1}}
In[]:=
Flatten[Table[{p,i}{Mod[Length[#],3],#[[Total[{3,1}*QuotientRemainder[Length[#],3]]]]}&[TSPatternEvolve[Join[{i,_,_},Table[_,p]],1]],{p,0,2},{i,0,1}]]
Out[]=
{{0,0}{2,0},{0,1}{1,1},{1,0}{0,0},{1,1}{2,1},{2,0}{1,0},{2,1}{0,1}}
In[]:=
Flatten[Table[{p,i}TSPatternEvolve[Join[{i,_,_},Table[_,p]],1],{p,0,2},{i,0,1}]]
Out[]=
{{0,0}{0,0},{0,1}{1,1,0,1},{1,0}{_,0,0},{1,1}{_,1,1,0,1},{2,0}{_,_,0,0},{2,1}{_,_,1,1,0,1}}

Blocks+residue representation (condensed form)

{{s1,s2,s3,...},residue}
In[]:=
ToModForm[list_List]:={Take[list,1;;-3;;3],Take[list,-Mod[Length[list],3]]}
In[]:=
ToModForm[s:{_}]:={{},s}
In[]:=
ToModForm[{}]:={{},{}}
In[]:=
Table[ToModForm[Table[0,n]],{n,0,10}]//Column
Out[]=
{{},{}}
{{},{0}}
{{},{0,0}}
{{0},{}}
{{0},{0}}
{{0},{0,0}}
{{0,0},{}}
{{0,0},{0}}
{{0,0},{0,0}}
{{0,0,0},{}}
{{0,0,0},{0}}
In[]:=
NestList[Replace[#,{{0,_,_,s___}{s,0,0},{1,_,_,s___}{s,1,1,0,1}}]&,{1,1,1,1,1},20]
Out[]=
{{1,1,1,1,1},{1,1,1,1,0,1},{1,0,1,1,1,0,1},{1,1,0,1,1,1,0,1},{1,1,1,0,1,1,1,0,1},{0,1,1,1,0,1,1,1,0,1},{1,0,1,1,1,0,1,0,0},{1,1,0,1,0,0,1,1,0,1},{1,0,0,1,1,0,1,1,1,0,1},{1,1,0,1,1,1,0,1,1,1,0,1},{1,1,1,0,1,1,1,0,1,1,1,0,1},{0,1,1,1,0,1,1,1,0,1,1,1,0,1},{1,0,1,1,1,0,1,1,1,0,1,0,0},{1,1,0,1,1,1,0,1,0,0,1,1,0,1},{1,1,1,0,1,0,0,1,1,0,1,1,1,0,1},{0,1,0,0,1,1,0,1,1,1,0,1,1,1,0,1},{0,1,1,0,1,1,1,0,1,1,1,0,1,0,0},{0,1,1,1,0,1,1,1,0,1,0,0,0,0},{1,0,1,1,1,0,1,0,0,0,0,0,0},{1,1,0,1,0,0,0,0,0,0,1,1,0,1},{1,0,0,0,0,0,0,1,1,0,1,1,1,0,1}}
In[]:=
ToModForm/@%
Out[]=
{{{1},{1,1}},{{1,1},{}},{{1,1},{1}},{{1,1},{0,1}},{{1,0,1},{}},{{0,1,1},{1}},{{1,1,1},{}},{{1,1,1},{1}},{{1,1,1},{0,1}},{{1,1,0,1},{}},{{1,0,1,1},{1}},{{0,1,1,1},{0,1}},{{1,1,1,0},{0}},{{1,1,0,0},{0,1}},{{1,0,0,0,1},{}},{{0,0,0,1,1},{1}},{{0,0,1,1,1},{}},{{0,1,1,1},{0,0}},{{1,1,1,0},{0}},{{1,1,0,0},{0,1}},{{1,0,0,0,1},{}}}
In[]:=
NestList[TSModStep,{{1},{1,1}},20]
Out[]=
{{{1},{1,1}},{{1,1},{}},{{1,1},{1}},{{1,1},{0,1}},{{1,0,1},{}},{{0,1,1},{1}},{{1,1,1},{}},{{1,1,1},{1}},{{1,1,1},{0,1}},{{1,1,0,1},{}},{{1,0,1,1},{1}},{{0,1,1,1},{0,1}},{{1,1,1,0},{0}},{{1,1,0,0},{0,1}},{{1,0,0,0,1},{}},{{0,0,0,1,1},{1}},{{0,0,1,1,1},{}},{{0,1,1,1},{0,0}},{{1,1,1,0},{0}},{{1,1,0,0},{0,1}},{{1,0,0,0,1},{}}}
In[]:=
Flatten[NestList[TSModStep,{{1},{1,1}},20]]
Out[]=
{1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0,1,1,0,1,1,1,0,1,1,1,0,1,1,1,1,0,0,1,1,0,0,0,1,1,0,0,0,1,0,0,0,1,1,1,0,0,1,1,1,0,1,1,1,0,0,1,1,1,0,0,1,1,0,0,0,1,1,0,0,0,1}
In[]:=
#[[1,1]]&/@NestList[TSModStep,{{1},{1,1}},20]
Out[]=
{1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,0,0,0,1,1,1}
Note: the only thing that matters is how long the residue is, not what it contains.... [[[ THIS APPEARS TO BE INCORRECT ]]]
Note that many values don’t matter
In[]:=
TSDirectEvolve[%51,1000]
Out[]=
{0,1,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,1,1,0,1,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}

Continuous sequence

Could just include the blocks that are added.....
In this case, can think of a “head” progressively moving down the tape....

Continuous body+residue sequence

What matters to the evolution

Only every 3rd element in the sequence really matters .... but one needs to know the phase

Numbering of inits

Halting Time Distribution

First “long case”
I.e. a decent fraction of cases go on the “long road”....
[[ NOTE: use ChartLayout->”Stacked” ]]

[ Compare to lifetimes of a random walk + random mapping ]

[Compressed form]

Generational Evolution

Compressed version:
Compressed version:

Final State Length vs Initial State Length

Longest Intermediate Length vs. Initial Length

State Transition Graph

[ Seeing a variety of “highways” ]

Ignoring “3-intermediate” values....
Full version:
[[ The 1
Freeways are associated with a small number of long-to-resolve cases
Note that in the size 5 inits case, the 10 attractor is a freeway .... but it “bushes out” in the 6 inits case.......
The first time you reach a freeway (with smallest init that does it), it’s not bushy...

Largest components

Freeway length ratios vs initial size:

Cycles

Clean the cycles:
Confirm that all cycles are different:

[ Look at cycles with _’s in them ]

Solving a “tag equation”

Systematically Find Cycles

Use compressed representations....
But the blanks will be filled in a definite way....
Alternative way to get an element of the final cycle:
There are cycles with all lengths of the form 2k, and there are Fibonacci[k+1] of them.
The 2-cycle is the 0101010....1 case....
I.e. there is a cycle of length 2w for every w, and the length in bits of the sequence associated with that cycle can be any even divisor of 2w (i.e. 2 Divisors[w])
The seeds for cycles:
These can be generated recursively:
Ed’s version
[[ This is essentially like “bracelet problem” ... cf https://www.wolframscience.com/nks/p255--systems-of-limited-size-and-class-2-behavior/ ]]
https://www.wolframscience.com/nks/notes-6-7--state-networks-for-shift-rules/
This is the power version; we need the Fibonacci version:

Cycles are given by all possible sequences of certain blocks

This procedure is not necessarily exhaustive [what about the cases with nonzero phase?]

The number of “traps” (i.e. states on cycles) seems to be of order ϕ^(n/2) ... compared to the total number of states 2^n

For a given length n, the probability of being trapped is of order

Non-standard cycle

This generates a cycle longer than twice its init length

Watanabe (1963)

Sequence Statistics

Can one invert the sequence and find the init?

“Glider Guns”?

a b b b b ....
T^p a b  a b b
There is a proof that some don’t exist....

Champions

20,858,069 steps

The length of the freeway is long compared to the number of possible distinct inputs....

Size 100

Approx. 2B steps.....

Size 50

(None found)

Trawlings from 10^5 random size 100s

Systematic search

600M
2.5B

Freeways [see above]

Given a long freeway, what feeds into the freeway, or is it mostly the freeway itself? (If the sequences in the freeway get big, it has to be the early part of the freeway that is its feeder)

Is there a bypass for the highway?

Mean Field Theory

Consider higher-order blocks, etc.
Assume 0 and 1 are equally frequent...
Then these occur with equal frequency....
I.e. equal probability for length +1, -1
But now the output is a random sequence of these two blocks.....

Forbidden blocks

First case: 1111
What is the first x__y__z__... forbidden block?
I.e. it is not precisely a random walk, even locally......

Block statistics

Causal Graphs

Should label with which rewrite was used....

Number Theory Version

Flip around number, then
Compare: https://www.wolframscience.com/nks/notes-12-8--turing-machine-600720/

Decidability

https://www.wolframscience.com/nks/p673--emulating-cellular-automata-with-other-systems/

Compare to Collatz Problem....

It does not have freeways....

Monogenic Tag Systems

Easy to solve.....

The Transfinite Tag System

Imagine there is an infinite tape.... and imagine that one goes an infinite number of steps.....
Tape is of length ω
After ω/3 steps, one has accumulated on average ω new elements