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[]:=
CloseKernels[];
In[]:=
LaunchKernels[];
In[]:=
Select[ParallelTable[Module[{ru,ca,lt,pcas,fitness},SeedRandom[9896778+i];NestList[CompoundExpression[ru=RandomRuleMutation[First[#]],ca=CellularAutomaton[ru,{{1},0},{200,All}];lt=TestCALifeTime[ca];If[lt==-Infinity,#,(*pcas=Table[PerturbCA[{ca,ru}],Ceiling[lt/20]];*)pcas=Table[PerturbedCellularAutomaton[ru,{{1},0},{200,{-150,150}},1],Ceiling[lt/10]];fitness=Min[Join[{lt},TestCALifeTime/@pcas]];If[fitness>=Last[#],{ru,fitness},#]]]&,{{0,4,1},0},2000]]//Last,{i,1000}],Last[#]>100&->{"Element","Index"}]
Out[]=
Element{{{329544069266708592463225775856558462236,4,1},105},{{123508487018209309850362627631298163528,4,1},110},{{163313090342284595938913846502066693128,4,1},112},{{322945229948492362661182721894198120504,4,1},101},{{292198784645215941321088592407235122960,4,1},101},{{31695255581700470911902716317105858104,4,1},105},{{4276479724016731948913745978675710344,4,1},104},{{234969409870737885186155122705247389456,4,1},106}},Index{93,173,212,419,471,626,760,964}
In[]:=
TransposeValues
Out[]=
{{{{329544069266708592463225775856558462236,4,1},105},93},{{{123508487018209309850362627631298163528,4,1},110},173},{{{163313090342284595938913846502066693128,4,1},112},212},{{{322945229948492362661182721894198120504,4,1},101},419},{{{292198784645215941321088592407235122960,4,1},101},471},{{{31695255581700470911902716317105858104,4,1},105},626},{{{4276479724016731948913745978675710344,4,1},104},760},{{{234969409870737885186155122705247389456,4,1},106},964}}
In[]:=
PlotCA[CellularAutomaton[#[[1,1]],{{1},0},{150,{-100,100}}],ImageSize->{Automatic,250}]&/@
Out[]=
,
,
,
,
,
,
,
NOTE: different fitness criterion
In[]:=
Module[{ru,ca,lt,pcas,fitness},SeedRandom[426778+132];NestList[CompoundExpression[ru=RandomRuleMutation[First[#]],ca=CellularAutomaton[ru,{{1},0},{200,All}];lt=TestCALifeTime[ca];If[lt==-Infinity,#,(*pcas=Table[PerturbCA[{ca,ru}],Ceiling[lt/20]];*)pcas=Table[PerturbedCellularAutomaton[ru,{{1},0},{200,{-150,150}},1],5];fitness=Min[Join[{lt},TestCALifeTime/@pcas]];If[fitness>=Last[#],{ru,fitness},#]]]&,{{0,4,1},0},2000]]//Last
Out[]=
{{297413941736400589979939780692294751544,4,1},190}
In[]:=
PlotCA[CellularAutomaton[{297413941736400589979939780692294751544,4,1},{{1},0},{150,{-100,100}}],ImageSize->{Automatic,250}]
Out[]=
In[]:=
GraphicsGrid[Partition[Table[PlotCA[With[{ru={297413941736400589979939780692294751544,4,1}},SeedRandom[424324+i];PerturbedCellularAutomaton[ru,{{1},0},{200,{-5,100}},1]],"ArrowSize"->Small,"Trim"->{None,None},ImageSize->{Automatic,400}],{i,60}],8]]
Out[]=
Perturbations
Perturbations
To Do
To Do
FeatureSpacePlot
FeatureSpacePlot
Cluster analysis tree.
Cluster analysis tree.
Long lived exhaustive search
Long lived exhaustive search
? Machine learning prediction of lifetime from width
? Machine learning prediction of lifetime from width
Machine learning for treatment
Machine learning for treatment