You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
In[]:=
Module{deep=5000,cut=200,ru,life,evo,all,data,res},all=MapSeedRandom[#];evo=NestListCompoundExpressionru=[First[#]],life=[ru,cut],If[life>=Last[#],{ru,life},#]&,{{0,3,1},1},deep;evo=First/@SplitBy[evo,Last];evo&,{426888,426788};AppendTo[all,MapAt[{#,3,1}&,#,1]&/@{{0,1},{54,1},{1699400088108,2},{4670237948820,5},{2722323165603,6},{4463167165719,11},{4464329427186,17},{4464458626398,29},{2906889909000,38},{2905727647290,67},{2602407332391,121},{3606720814104,134},{2759432204661,244},{4359737104557,444},{4359737106744,723}}];res=MapCompoundExpressiondata=CellularAutomaton[First[#],{{1},0},Last[#]+4],data=ArrayPad[#,2]&/@data,ArrayPlotdata,ColorRules->["Colors"],FrameStyle->GrayLevel[.65],ImageSize->{Automatic,20Sqrt[Length[data]+1]}&,#&/@all;Column[Map[Row[#,Spacer[.2]]&,res],Dividers->{False,Thread[Range[2,3]->LightGray]},Spacings->2]
In[]:=
Out[]=
0,1,2,3
In[]:=
ArrayPlotCellularAutomaton[{4359737104557,3,1},{{1},0},500],ColorRules->0,1,2,3
Out[]=
In[]:=
injury[list_,delta_:0]:=MapAt[Mod[#+1,3]&,list,Round[Length[list]/2]+delta]
In[]:=
Dimensions[CellularAutomaton[{4359737104557,3,1},{{1},0},500]]
Out[]=
{501,66}
In[]:=
ArrayPlotWith[{ev=CellularAutomaton[{4359737104557,3,1},{{1},0},300]},Join[ev,CellularAutomaton[{4359737104557,3,1},injury[Last[ev]],200]]],ColorRules->0,1,2,3
Out[]=
In[]:=
TableArrayPlotWith[{ev=CellularAutomaton[{4359737104557,3,1},{{1},0},300]},Join[ev,CellularAutomaton[{4359737104557,3,1},injury[Last[ev],d],200]]],ColorRules->0,1,2,3,{d,-10,10}
Out[]=
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,
,