NewScience > FollowOnInitiatives > SummerSchool > 2007 >

[ Old bulletin had the rule transcribed wrong! ]

In[]:=
TSPatternEvolve2[init_,t_]:=With[{ru=Dispatch[{{0,_,s___}{s,1},{1,_,s___}{s,1,1,0}}]},NestList[Replace[#,ru]&,init,t]]
In[]:=
ListStepPlot[Length/@TSPatternEvolve2[{1,0},100]]
Out[]=
20
40
60
80
100
10
20
30
40
50
In[]:=
ListStepPlot[Differences[Length/@TSPatternEvolve2[{1,0},100]]]
Out[]=
20
40
60
80
100
-1.0
-0.5
0.5
1.0
Note: it cannot eliminate 1s.....
In[]:=
ListStepPlot[MapIndexed[#1-(Sqrt[2]-1)First[#2]&,Length/@TSPatternEvolve2[{1,0},100]]]
Out[]=
20
40
60
80
100
1
2
3
4
5
6
7
In[]:=
ListStepPlot[MapIndexed[#1-(Sqrt[2]-1)First[#2]&,Length/@TSPatternEvolve2[{1,0},1000]]]
Out[]=
200
400
600
800
1000
-5
5
10
15
20
In[]:=
ListStepPlot[MapIndexed[#1-(Sqrt[2]-1)First[#2]&,Length/@TSPatternEvolve2[{1,0},10000]]]
Out[]=
2000
4000
6000
8000
10000
-20
-10
10
20
30
In[]:=
TSPatternEvolve2[{1,0},100]//Last
Out[]=
{0,1,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,0,1,1,1,0,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,0,1,1,0,1,1,0}
No 1 is isolated.... Every 0 is isolated.
Does this ever terminate? Any time you have a 1, it always produces another....

From 2007:

In[]:=
TagStepX[list_]:=If[Length[list]<2,{},Join[Drop[list,2],{{0,1},{1,0,0}}[[list[[1]]+1]]]]
TagLengthFunction[{2,{{1},{1,1,0}}}]
CompiledFunction[{init,steps},Module[{len$,state$,lengths$=Table[0,{steps}]},state$=init;Do[len$=Length[state$];lengths$〚i〛=len$;If[len$<2,state$={1},If[state$〚1〛===0,state$=Join[Drop[state$,2],{1}],state$=Join[Drop[state$,2],{1,1,0}]]],{i,steps}];lengths$],-CompiledCode-]
In[]:=
NestList[TagStepX,{1,0,0},20]
Out[]=
{{1,0,0},{0,1,0,0},{0,0,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1},{0,1,0,1}}