In[]:=
{ru,init,txspec}={{299459058088077823758143088095350287424,4,1},{{1},0},{200,{-110,110}}};

Width history prediction

Getting training data

In[]:=
awh=Module[{ru={299459058088077823758143088095350287424,4,1},init={{1},0},txspec={200,{-110,110}},aps,pca,ca},(If[#=={},0,#[[2]]-#[[1]]+1]&[nonzeroRange[#]]&/@PerturbedCellularAutomaton[ru,init,txspec,#,"ReturnPerturbations"->False]&/@allperts[ru,init,txspec])];
In[]:=
rh=Module[​​{ru={299459058088077823758143088095350287424,4,1},​​init={{1},0},txspec={200,{-110,110}},aps,pca,ca},​​SeedRandom[444666];​​HealCA[ru,init,txspec,#,1,(#==101&)]&/@RandomSample[allperts[ru,init,txspec],10]];
Out[]=
$Aborted
In[]:=
rh
Out[]=
{{{63,116}2},{{41,125}1},{{89,113}2},{},{{89,108}3},{{28,113}1},{{73,115}2},{{82,129}2},{},{{59,124}1}}
In[]:=
rh=Module[​​{ru={299459058088077823758143088095350287424,4,1},​​init={{1},0},txspec={200,{-110,110}},aps,pca,ca},​​SeedRandom[444666];​​ParallelMap[HealCA[ru,init,txspec,#,1,(80<#<120&),"Order"->"Random"]&,Select[allperts[ru,init,txspec],30<Keys[#][[1,1]]<60&]]];
In[]:=
alltrain=Module[{ru={299459058088077823758143088095350287424,4,1},init={{1},0},txspec={200,{-110,110}},aps,pca,ca},​​MapThread[If[#=={},0,#[[2]]-#[[1]]+1]&[nonzeroRange[#]]&/@PerturbedCellularAutomaton[ru,init,txspec,#1,"ReturnPerturbations"->False]->Keys[#2][[1,1]]&,{Select[allperts[ru,init,txspec],30<Keys[#][[1,1]]<60&],Catenate[rh]}]];
How good are these healers anyway?
In[]:=
nr=Module[{ru={299459058088077823758143088095350287424,4,1},init={{1},0},txspec={200,{-110,110}},aps,pca,ca},​​MapThread[TestCALifeTime[PerturbedCellularAutomaton[ru,init,txspec,Join[#1,#2],"ReturnPerturbations"->False]]&,{Select[allperts[ru,init,txspec],30<Keys[#][[1,1]]<60&],Catenate[rh]}]];
In[]:=
Histogram[nr]
Out[]=
Answer: pretty good
In[]:=
Length[alltrain]
Out[]=
1233

Training

In[]:=
SeedRandom[222444];​​test=alltrain[[ti=RandomSample[Range[Length[Select[allperts[ru,init,txspec],30<Keys[#][[1,1]]<60&]]],223]]];
In[]:=
train=Delete[alltrain,List/@ti];
In[]:=
p=Predict[train]​​
Out[]=
PredictorFunction
Input type:
Mixed (number: 201)
Method: RandomForest
Data not saved. Save now


Testing

In[]:=
ListPlot[(p/@test[[All,1]]),PlotHighlighting->None]
Out[]=
50
100
150
200
40
50
60
70
80
Loss:
In[]:=
ListPlot[test[[All,2]]-(p/@test[[All,1]]),PlotHighlighting->None,PlotRange->{-50,50}]
Out[]=
50
100
150
200
-40
-20
20
40
In[]:=
Histogram[test[[All,2]]-(p/@test[[All,1]]),{5},PlotRange->{{-60,75},{0,40}}]
Out[]=
Random guess for comparison:
In[]:=
SeedRandom[444555];ListPlot[RandomInteger[{Keys[#][[1,1]],101}]&/@Select[allperts[ru,init,txspec],30<Keys[#][[1,1]]<60&][[ti]],PlotHighlighting->None]
Out[]=
50
100
150
200
20
40
60
80
100

Viz with growth curve