Wolfram Cloud Page

More Colors

In[]:=

TestCALifetime[ca_List]:=If[Total[Last[ca]]==0,Length[ca]-LengthWhile[Reverse[ca],Total[#]==0&],-Infinity]

In[]:=

GoFurtherTotal[{initrule_,steps_,iterations_,seed_}]:={ResourceFunction["AdaptiveCellularAutomaton"][<|"MutationFunction"->{2,"Symmetric"->True},"InitialRule"->initrule,"AdaptiveIterations"->iterations,"MaxSteps"->steps,"FitnessFunction":>(With[{ca=CellularAutomaton[#1,{{1},0},steps]},{life=TestCALifetime[ca]},If[life==-Infinity,-Infinity,Count[Sign[Take[ca,life]],1,{2}]]]&)|>,"BreakthroughStates",{"BestRule","BestFitness","Index"},RandomSeeding->seed],steps,iterations,seed}

In[]:=

ParallelMap[Function[i,Fold[Join[Most[#1],Map[Function[y,MapAt[Function[x,x+#1[[-1]]["Index"]],y,"Index"]],#2]]&,First/@Rest[NestList[GoFurtherTotal[{#[[1,-1]]["BestRule"],2#[[2]],2#[[3]],#[[4]]}]&,{{<|"BestRule"{0,3,1},"BestFitness"1,"Index"0|>},200,500,3456+i},1]]]],Range[40]];

In[]:=

Labeled[ArrayPlot[CellularAutomaton[#BestRule,{{1},0},420],ColorRules->"Colors",ImageSize->{Automatic,400}],{#BestFitness,#Index}]&/@Last/@%

Out[]=



{2663,130}

{380,372}

{906,270}

{754,711}

{1157,862}

{952,584}

{96,340}

{662,699}

{484,802}

{59,550}

{7898,387}

{754,210}

{302,960}

{1424,65}

{1200,545}

{513,449}

{5183,582}

{266,827}

{1786,349}

{1719,626}

{528,493}

{310,536}

{73,230}

{144,866}

{395,994}

{1116,777}

{197,376}

{1974,822}

{341,197}

{237,816}

{208,364}

{172,818}

{77,807}

{5183,973}

{6516,823}

{31,826}

{145,907}

{654,294}

{287,960}

{1291,735}



In[]:=

ParallelMap[Function[i,Fold[Join[Most[#1],Map[Function[y,MapAt[Function[x,x+#1[[-1]]["Index"]],y,"Index"]],#2]]&,First/@Rest[NestList[GoFurtherTotal[{#[[1,-1]]["BestRule"],2#[[2]],2#[[3]],#[[4]]}]&,{{<|"BestRule"{0,4,1},"BestFitness"1,"Index"0|>},200,500,3456+i},1]]]],Range[40]];

In[]:=