WOLFRAM NOTEBOOK

In[]:=
bigyellow = {297413941736400589979939780692294751544,4,1};
In[]:=
bigred = {201412842028162214137229450141139961424,4,1};
In[]:=
cands =DeleteDuplicates@
;ru = cands[[13]]; ca = getca[cands[[13]], 200];

Adaptive therapy

Multiple Perturbations

Scratchpad for puttiing new func in draft

3D magnification

In[]:=
Graphics3D[{{Texture[Normal[PlotCA[{PerturbedCellularAutomaton[ru,{{1},0},{{8,24},{-200,200}},{15,206}0,"ReturnPerturbations"->False],<|{15-8+1,206}->0|>},Mesh->All,MeshStyle->Opacity[.1],ImageSize->{Automatic,150},"MaxWidth"->{196,210},"Trim"->{None,None},"ArrowSize"->Large,"ArrowDirection"->"Left"]]],Polygon[{{-1,-1,-1},{1,-1,-1},{1,1,-1},{-1,1,-1}},VertexTextureCoordinates{{0,0},{1,0},{1,1},{0,1}}]}}]
Out[]=
In[]:=
Column[{ImageTake[PlotCA[ru,"Steps"->105,ImageSize->{{1,3000},{1,1500}},Mesh->All,MeshStyle->Opacity[.1]],{100,300},{1,260}],Show[PlotCA[ru,"Steps"->105,ImageSize->{Automatic,450},Mesh->All,MeshStyle->Opacity[.1]],Graphics[{EdgeForm@Black,FaceForm@None,Rectangle[{0,85},{25,99}]}]]}]

For blog

In[]:=
ip=cps[[2]];ica=PerturbedCellularAutomaton[ru,{{1},0},{200,{-50,50}},ip];ilt=Replace[TestCALifeTime[ica],-Infinity:>201];iaps=Select[allperts[First[ica],ru[[2]]],Keys[#][[1,1]]>=Keys[ip][[-1,1]]&];
In[]:=
therapies=(*Table[*)Module[{fitness=Infinity,ltgoal=TestLifetime[ru,200],pca},SeedRandom[333555];NestList[Function[{fitness,perts,aps},pca=PerturbedCellularAutomaton[ru,{{1},0},{200,{-50,50}},Join[perts,RandomChoice[aps]]];plt=Replace[TestCALifeTime[First[pca]],-Infinity:>201];nf=Abs[plt-ltgoal];If[nf<fitness,{nf,Join[perts,Last[pca]],Select[allperts[First[pca],ru[[2]]],Keys[#][[1,1]]>=Keys[Last[pca]][[-1,1]]&]},{fitness,perts,aps}]]@@#&,{Abs[ilt-ltgoal],ip,iaps},10][[All,2]]](*,{i,2}]*);
In[]:=
GraphicsRow[PlotCA/@{ca,ica}]->GraphicsRow[PlotCA/@(PerturbedCellularAutomaton[ru,{{1},0},{200,{-50,50}},#[[1]]]&/@Rest[Split[therapies]])]
Out[]=

Blog pert

In[]:=
ip={23,111}2ica=PerturbedCellularAutomaton[ru,{{1},0},{200,{-110,110}},ip];ilt=Replace[TestCALifeTime[ica],-Infinity:>201];iaps=Select[allperts[First[ica],ru[[2]]],Keys[#][[1,1]]>=Keys[ip][[-1,1]]&];
Out[]=
{23,111}2
In[]:=
therapies=Table[Module[{ru={299459058088077823758143088095350287424,4,1},fitness=Infinity,ltgoal=TestLifetime[ru,200],pca},SeedRandom[333557+i];NestList[Function[{fitness,perts,aps},pca=PerturbedCellularAutomaton[ru,{{1},0},{200,{-110,110}},Join[perts,RandomChoice[aps]]];plt=Replace[TestCALifeTime[First[pca]],-Infinity:>201];nf=Abs[plt-ltgoal];If[nf<fitness,{nf,Join[perts,Last[pca]],Select[allperts[First[pca],ru[[2]]],Keys[#][[1,1]]>=Keys[Last[pca]][[-1,1]]&]},{fitness,perts,aps}]]@@#&,{Abs[ilt-ltgoal],ip,iaps},10][[All,2]]],{i,10}];
In[]:=
therapiesx=Table[Module[{ru={299459058088077823758143088095350287424,4,1},fitness=Infinity,ltgoal=TestLifetime[ru,200],pca},SeedRandom[333557+i];NestList[Function[{fitness,perts,aps},pca=PerturbedCellularAutomaton[ru,{{1},0},{200,{-110,110}},Join[perts,RandomChoice[aps]]];plt=Replace[TestCALifeTime[First[pca]],-Infinity:>201];If[Abs[plt-ltgoal]<Abs[fitness-ltgoal],{plt,Join[perts,Last[pca]],Select[allperts[First[pca],ru[[2]]],Keys[#][[1,1]]>=Keys[Last[pca]][[-1,1]]&]},{fitness,perts,aps}]]@@#&,{ilt,ip,iaps},10]],{i,10}];

Restricted perturbations

Predicting based treatment based on width

Predicting from previous widths

Wolfram Cloud

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 »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.