Take 2 rules and randomly recombine them at each step

In[]:=
RandomCrossover[{ru1_,ru2_}]:=Module[{len=ru1[[2]]^(2ru1[[3]]+1),rules={ru1,ru2}[[RandomChoice[{{1,2},{2,1}}]]],cp},cp=RandomInteger[{1,len}];{FromDigits[Join[Take[IntegerDigits[rules[[1,1]],ru1[[2]],len],cp],Drop[IntegerDigits[rules[[2,1]],ru1[[2]],len],cp]],ru1[[2]]],ru1[[2]],ru1[[3]]}]
In[]:=
RandomCrossoverPair[{ru1_,ru2_}]:=Module[{len=ru1[[2]]^(2ru1[[3]]+1),rules={ru1,ru2}[[RandomChoice[{{1,2},{2,1}}]]],cp},cp=RandomInteger[{1,len-1}];{{FromDigits[Join[Take[IntegerDigits[rules[[1,1]],ru1[[2]],len],cp],Drop[IntegerDigits[rules[[2,1]],ru1[[2]],len],cp]],ru1[[2]]],ru1[[2]],ru1[[3]]},{FromDigits[Join[Take[IntegerDigits[rules[[2,1]],ru1[[2]],len],cp],Drop[IntegerDigits[rules[[1,1]],ru1[[2]],len],cp]],ru1[[2]]],ru1[[2]],ru1[[3]]}}]
In[]:=
RuleMeiosisFusion[r1:{rn1_,k_,r_},r2:{rn2_,k_,r_}]:=Block[{len=k^(2r+1),cut1,cut2,chromosome11,chromosome12,chromosome21,chromosome22,haploids1,haploids2,offsprings},​​{cut1,cut2}=RandomInteger[{1,Floor[(len-1)/2]},2];​​{chromosome11,chromosome12}=Transpose@Partition[IntegerDigits[rn1,k,k^(2r+1)],2];​​{chromosome21,chromosome22}=Transpose@Partition[IntegerDigits[rn2,k,k^(2r+1)],2];​​haploids1={Join[Take[chromosome11,cut1],Drop[chromosome12,cut1]],Join[Take[chromosome12,cut1],Drop[chromosome11,cut1]]};​​haploids2={Join[Take[chromosome21,cut2],Drop[chromosome22,cut2]],Join[Take[chromosome22,cut2],Drop[chromosome21,cut2]]};​​(*fusehomologoushaploidstoproducestwopossibleoff-springs*)​​offsprings=MapThread[List/*Transpose/*Catenate/*({FromDigits[ReplacePart[#,-1->0],k],k,r}&),{haploids1,haploids2}];​​​​(*choosenextpairrandomlyfromparentsandoffsprings*)​​RandomSample[DeleteDuplicates@Join[{r1,r2},offsprings],2]​​(*RandomSample[DeleteDuplicates@Join[offsprings,​​MapThread[List/*Thread/*Catenate/*({FromDigits[ReplacePart[#,-1->0],k],k,r}&),{haploids1,Reverse@haploids2}],​​MapThread[List/*Thread/*Catenate/*({FromDigits[ReplacePart[#,-1->0],k],k,r}&),{Reverse@haploids1,haploids2}]],​​2​​]*)​​]
In[]:=
RuleMeiosisFusion[{0,3,1},{3^26+3,3,1}]
Out[]=
{{2541865828332,3,1},{0,3,1}}
In[]:=
RandomPicking[r1:{rn1_,k_,r_},r2:{rn2_,k_,r_}]:=Block[{​​size=k^(2r+1),​​cases1,cases2​​},​​cases1=IntegerDigits[rn1,k,size];​​cases2=IntegerDigits[rn2,k,size];​​{FromDigits[MapThread[RandomChoice,{cases1,cases2}],k],k,r}​​]
In[]:=
RandomCrossover[{{30,2,1},{45,2,1}}]
Out[]=
{29,2,1}
ParallelTable[Module[​​{deep=5000,cut=200,ru,life,evo,data,lw},​​evo=NestList[CompoundExpression[​​ru=RandomRuleMutation[First[#],1,"Symmetric"->True],​​cc=CACenterUniformCriterion[ru,cut],​​If[cc!=-Infinity&&cc>=Last[#],{ru,cc},#]​​]&,{{0,4,1},0},deep];​​evo=Rest[First/@SplitBy[evo,Last]]​​],150];
In[]:=
ParallelTable[Module[​​{deep=500,cut=200,ru,life,evo,data},​​SeedRandom[426778];​​evo=NestList[CompoundExpression[​​ru=RandomCrossover[First[#]],​​life=Echo@TestLifetime[ru,cut],​​If[life>=Last[#],{{ru,RandomChoice[First[#]]},life},#]​​]&,{{{3RandomInteger[3^26-1],3,1},{3RandomInteger[3^26-1],3,1}},0},deep];​​evo=Rest[First/@SplitBy[evo,Last]];​​Map[CompoundExpression[​​data=CellularAutomaton[​​#[[1,1]],{{1},0},Last[#]+2],​​data=ArrayPad[#,2]&/@data,​​ArrayPlot[data,ColorRules->colors,​​ImageSize->{Automatic,26Sqrt[Length[data]+1]},​​Mesh->True,MeshStyle->Opacity[.1]​​]​​]&,​​evo]​​],10]
Out[]=
$Aborted
In[]:=
NestList[RandomCrossoverPair,{{30,2,1},{126,2,1}},10]
Out[]=
{{{30,2,1},{126,2,1}},{{30,2,1},{126,2,1}},{{30,2,1},{126,2,1}},{{94,2,1},{62,2,1}},{{94,2,1},{62,2,1}},{{62,2,1},{94,2,1}},{{94,2,1},{62,2,1}},{{126,2,1},{30,2,1}},{{126,2,1},{30,2,1}},{{30,2,1},{126,2,1}},{{62,2,1},{94,2,1}}}
In[]:=
Module[​​{deep=500,cut=200,ru,life,evo,data,pair},​​SeedRandom[426778];​​evo=NestList[CompoundExpression[​​pair=RandomCrossoverPair[First[#]],​​life=Catch[Min[If[#===-Infinity,Throw[-Infinity],#]&[TestLifetime[#,cut]]&/@pair]],​​If[life>=Last[#],{pair,life},#]​​]&,{{{0,3,1},{3RandomInteger[3^26-1],3,1}},0},deep];​​evo=Rest[First/@SplitBy[evo,Last]];​​Map[CompoundExpression[​​data=CellularAutomaton[​​#[[1,1]],{{1},0},Last[#]+2],​​data=ArrayPad[#,2]&/@data,​​ArrayPlot[data,ColorRules->colors,​​ImageSize->{Automatic,26Sqrt[Length[data]+1]},​​Mesh->True,MeshStyle->Opacity[.1]​​]​​]&,​​evo]​​]
Out[]=
{}
In[]:=
{{0,3,1},{3RandomInteger[3^26-1],3,1}}
Out[]=
{{0,3,1},{5108151069384,3,1}}
In[]:=
RandomCrossoverPair[%]
Out[]=
{{24419412726,3,1},{2,3,1}}
In[]:=
Module[​​{deep=5000,cut=200,ru,life,evo,data,pair},​​evo=NestList[CompoundExpression[​​pair=RuleMeiosisFusion@@First[#],​​life=Catch[Min[If[#===-Infinity,Throw[-Infinity],#]&[TestLifetime[#,cut]]&/@pair]],​​If[life>=Last[#],{pair,life},#]​​]&,{{{0,3,1},{3RandomInteger[3^(3^3-1)-1],3,1}},0},deep];​​evo=Rest[First/@SplitBy[evo,Last]];​​Map[​​Table[​​data=CellularAutomaton[​​#[[1,i]],{{1},0},#[[2]]+2];​​data=ArrayPad[#,2]&/@data;​​ArrayPlot[data,ColorRules->colors,​​ImageSize->{Automatic,26Sqrt[Length[data]+1]},​​Mesh->True,MeshStyle->Opacity[.1]​​]​​,{i,2}​​]&,​​evo]​​]

More

Recombinations

Model

At each step pick from the population pairs at random; for each pair try a random crossover; iterate this until there’s a useful result (or at least not lower)
Here we are doing mating events rather than mutations; each mating event updates the population
For every edge, we get all crossovers ... then select the first one that isn’t of lower fitness than Max[parent1, parent2]