Prognosis

In[]:=
pcas=With[{ru={299459058088077823758143088095350287424,4,1}},PerturbedCellularAutomaton[ru,{{1},0},{400,{-30,40}},#]&/@allperts[CellularAutomaton[ru,{{1},0},{400,{-30,40}}]]];
In[]:=
lts=TestCALifeTime/@pcas;
In[]:=
widths=If[Length[#]===0,0,Last[#]-First[#]+1]&[nonzeroRange[#]]&/@#&/@pcas[[All,1]];
In[]:=
Show[Histogram[Pick[lts,widths[[#,30]]<9&&widths[[#,30]]!=0&/@Range[Length[pcas]]],{3},"Probability",PlotRange->{{0,200},Automatic},Frame->True,AspectRatio->.4],Histogram[lts,{3},"Probability",ChartStyle->Opacity[.1,Green]]]
Out[]=
In[]:=
width0=If[Length[#]===0,0,Last[#]-First[#]+1]&[nonzeroRange[#]]&/@PerturbedCellularAutomaton[{299459058088077823758143088095350287424,4,1},{{1},0},{400,{-30,40}},<||>];
In[]:=
ListLinePlot[%]
Out[]=
Show[Histogram[Pick[lts,widths[[#,30]]<9&&widths[[#,30]]!=0&/@Range[Length[pcas]]],{3},"Probability",PlotRange->{{0,200},Automatic},Frame->True,AspectRatio->.4],Histogram[lts,{3},"Probability",ChartStyle->Opacity[.1,Green]]]
In[]:=
width0[[30]]
Out[]=
9
In[]:=
width0[[20]]
Out[]=
10
In[]:=
Count[widths[[#,30]]<9&&widths[[#,30]]!=0&/@Range[Length[pcas]],True]
Out[]=
137
In[]:=
Count[widths[[#,20]]<10&&widths[[#,20]]!=0&/@Range[Length[pcas]],True]
Out[]=
91
In[]:=
Table[Count[widths[[#,t]]<width0[[t]]&&widths[[#,t]]!=0&/@Range[Length[pcas]],True],{t,50}]
Out[]=
{0,0,4,3,6,10,7,17,16,16,38,49,59,66,83,64,64,90,112,91,63,90,96,171,204,209,228,159,72,137,114,132,174,211,204,245,368,360,399,433,397,461,174,172,227,350,342,471,528,527}
In[]:=
ListLinePlot[%]
Out[]=
In[]:=
width0[[25]]
Out[]=
12
In[]:=
[[25]]
Out[]=
204
In[]:=
204/4383//N
Out[]=
0.0465435
In[]:=
Median[lts]
Out[]=
106
In[]:=
Quartiles[lts]
Out[]=
{100,106,125}
In[]:=
Median[Pick[lts,widths[[#,25]]<12&&widths[[#,25]]!=0&/@Range[Length[pcas]]]]
Out[]=
57
In[]:=
Quartiles[Pick[lts,widths[[#,25]]<12&&widths[[#,25]]!=0&/@Range[Length[pcas]]]]
Out[]=

69
2
,57,103
In[]:=
N[%]
Out[]=
{34.5,57.,103.}
In[]:=
Select[lts,#>=25&]//Length
Out[]=
4334
In[]:=
Length[lts]
Out[]=
4383
In[]:=
%282-%281
Out[]=
49
In[]:=
49/4383//N
Out[]=
0.0111796
In[]:=
ListLinePlot[Pick[widths,widths[[#,25]]<12&&widths[[#,25]]!=0&/@Range[Length[pcas]]]]
Out[]=
100
200
300
400
10
20
30
40
50
60
70
In[]:=
GraphicsRowShowListStepPlotPick[widths,widths[[#,25]]<12&&widths[[#,25]]!=0&/@Range[Length[pcas]]],PlotRange->#,PlotStyle->
,AspectRatio->.4,Frame->True,FrameLabel->{"step","width"},ListStepPlotwidth0,PlotStyle->
&/@{{{0,50},{0,30}},{{0,240},Automatic}}
Out[]=
ShowListStepPlotPick[widths,widths[[#,25]]<12&&widths[[#,25]]!=0&/@Range[Length[pcas]]],PlotRange->{{0,50},{0,30}},PlotStyle->
,AspectRatio->.4,Frame->True,FrameLabel->{"step","width"},ListStepPlotwidth0,PlotStyle->

Out[]=
In[]:=
ColorData[116,"ColorList"][[1]]

Treatments

Finding self healers

Biological Evolution