In[]:=
TSPatternEvolveList[{1,1,0,1},10]
Out[]=
{{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},{0,0,1,1,0,1}}
In[]:=
ToPhaseForm/@%1104
Out[]=
{{2,{1,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}}}
In[]:=
TSPhaseEvolveList[{2,{1,1}},10]
Out[]=
{{2,{1,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}},{1,{1,0}},{0,{0,1}}}
In[]:=
FromPhaseForm/@TSPhaseEvolveList[{2,{1,1}},20]
Out[]=
{{1,_,_,1},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0},{1,_,_,0,0},{0,_,_,1,0,0}}
In[]:=
FromPhaseForm[{0,{0,1}}]
Out[]=
{0,_,_,1,_,_}

To find a cycle ... start from

{0,{1,
​

Phase calculations

In[]:=
TSPatternEvolve[{0,_,_},1]
Out[]=
{0,0}
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}{Mod[Length[#],3],Drop[#,3Quotient[Length[#],3]]}&[TSPatternEvolve[Join[{i,_,_},Table[_,p]],1]],{p,0,2},{i,0,1}]]
Out[]=
{{0,0}{2,{0,0}},{0,1}{1,{1}},{1,0}{0,{}},{1,1}{2,{0,1}},{2,0}{1,{0}},{2,1}{0,{}}}
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}}
{{0,0}{2,{}},{0,1}{1,{1}},
In[]:=
TSSWPhaseStep[{phase_,state_}]:=Module[{p1,s1},​​{p1,s1}=Replace[{{0,0}{2,{0,0}},{0,1}{1,{1}},{1,0}{0,{}},{1,1}{2,{0,1}},{2,0}{1,{0}},{2,1}{0,{}}}][{phase,First[state]}];​​{p1,Join[Rest[state],s1]}​​]
In[]:=
TSPatternEvolve[#,1]&/@Tuples[{1,0},4]
Out[]=
{{1,1,1,0,1},{0,1,1,0,1},{1,1,1,0,1},{0,1,1,0,1},{1,1,1,0,1},{0,1,1,0,1},{1,1,1,0,1},{0,1,1,0,1},{1,0,0},{0,0,0},{1,0,0},{0,0,0},{1,0,0},{0,0,0},{1,0,0},{0,0,0}}
In[]:=
ToSWPhaseForm/@Tuples[{1,0},4]
Out[]=
{{1,{1,1}},{1,{1,0}},{1,{1,1}},{1,{1,0}},{1,{1,1}},{1,{1,0}},{1,{1,1}},{1,{1,0}},{1,{0,1}},{1,{0,0}},{1,{0,1}},{1,{0,0}},{1,{0,1}},{1,{0,0}},{1,{0,1}},{1,{0,0}}}
In[]:=
TSSWPhaseStep/@%
Out[]=
{{2,{1,0,1}},{2,{0,0,1}},{2,{1,0,1}},{2,{0,0,1}},{2,{1,0,1}},{2,{0,0,1}},{2,{1,0,1}},{2,{0,0,1}},{0,{1}},{0,{0}},{0,{1}},{0,{0}},{0,{1}},{0,{0}},{0,{1}},{0,{0}}}
{spaced,residue}
In[]:=
ToModForm[{1,1,0,0,1,1,1,0,1,0}]
Out[]=
{{1,0,1},{0}}
In[]:=
ToModForm[{1,1}]
Out[]=
{{},{1,1}}
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[]:=
Take[{0},1;;2;;3]
Take
:Cannot take positions 1 through 2 in {0}.
Out[]=
Take[{0},1;;2;;3]
In[]:=
Clear[ToModForm]
Take the residue...
{0{0,0},1{1,1,0,1}}
{Join[Rest[si],First[#]],Last[#]}&[ToModForm[Join[res,{{0,0},{1,1,0,1}}[[1+First[si]]]]]]
In[]:=
ToModForm[TSPatternEvolve[#,1]]===TSModStep[ToModForm[#]]&/@Tuples[{1,0},5]
Out[]=
{True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True}
In[]:=
Tuples[{1,0},0]
Out[]=
{{}}
In[]:=
Table[ToModForm[TSPatternEvolve[#,1]]===TSModStep[ToModForm[#]]&/@Tuples[{1,0},n],{n,0,7}]
Out[]=
{{True},{True,True},{True,True,True,True},{True,True,True,True,True,True,True,True},{True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True},{True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True},{True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True},{True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True}}
In[]:=
ArrayPlot[PadRight[First/@NestList[TSModStep,ToModForm[{1,0,0,1,0,0,1,0,0,0,0,0}],50],Automatic,.5]]
Out[]=
In[]:=
NestList[TSModStep,ToModForm[{1,0,0,1,0,0,1,0,0,0,0,0}],5]
Out[]=
{{{1,1,1,0},{}},{{1,1,0,1},{1}},{{1,0,1,1},{0,1}},{{0,1,1,0,1},{}},{{1,1,0,1},{0,0}},{{1,0,1,0,1},{}}}

Cycle Structure

Not always compositions of:

Freeways

There is a freeway because as soon the intermediates get big, they will not have incoming trees from the sizes we’ve looked at....