Wolfram Cloud Page

WOLFRAM NOTEBOOK

ParallelTable[Module[{res=(SeedRandom[42343+i];NestList[First[MinimalBy[Append[Table[CARuleMutation[#],5],#],DeathLossFunction[#,500]&]]&,{0,3,1},1000]),uniqs},uniqs=First/@(First/@SplitBy[{#,DeathLossFunction[#,500]}&/@res,Last]);{#->{-DeathLossFunction[#,500],Flatten[Position[res,#]][[1]]}}&/@uniqs],{i,150}]

In[]:=

SeedRandom[426778];NestList[Module[{ru=CARuleMutation[First[#]],loss},If[(loss=DeathLossFunction[ru,500])<=Last[#],{ru,loss},#]]&,{{0,3,1},0},400]

In[]:=

AlwaysGainList[list_]:={#2[[1]][[1]],-#2[[1]][[2]],Length[#1]}&@@@Partition[SplitBy[list,Last],2,1]

In[]:=

AlwaysGainList[%89]

Out[]=

{{{1558690240158,3,1},1,38},{{514023487596,3,1},4,47},{{4567913185281,3,1},5,55},{{7287436131117,3,1},6,91},{{5592884421399,3,1},7,9},{{5586032021307,3,1},10,34},{{5593005590109,3,1},13,1},{{5624515853304,3,1},15,33},{{5624518978527,3,1},16,14}}

In[]:=

IncludeNeutralList[list_]:={Last[#][[1]][[1]],-Last[#][[1]][[2]],Length[#]}&/@Partition[SplitBy[list,First],2,1]

In[]:=

MakePix1[list_]:=Map[Labeled[ArrayPlot[CellularAutomaton[#[[1]],{{1},0},#[[2]]+5],ColorRules->{0->White,1->Red,2->Blue,3->Green}],{#[[2]],#[[3]]}]&,list]

In[]:=

MakePix1[AlwaysGainList[SeedRandom[426778];NestList[Module[{ru=CARuleMutation[First[#]],loss},If[(loss=DeathLossFunction[ru,500])<=Last[#],{ru,loss},#]]&,{{0,3,1},0},400]]]

Out[]=



{1,38}

{4,47}

{5,55}

{6,91}

{7,9}

{10,34}

{13,1}

{15,33}

{16,14}



In[]:=

MakePix1[AlwaysGainList[SeedRandom[426778];NestList[Module[{ru=CARuleMutation[First[#]],loss},If[(loss=DeathLossFunction[ru,500])<=Last[#],{ru,loss},#]]&,{{0,3,1},0},5000]]]

Out[]=



{1,38}

{4,47}

{5,55}

{6,91}

{7,9}