Symmetry
Symmetry
In[]:=
CASymmetryElements[nColors_Integer]:=Keys[GroupBy[#->Union[Sort[{#,Reverse@#,Reverse[Reverse/@#],Reverse/@Transpose[#],Transpose@(Reverse/@#)}]]&/@(Normal@SparseArray[{{3,2}->#1,{2,3}->#2,{2,2}->#3,{2,1}->#4,{1,2}->#5}]&@@@Tuples[Range[0,nColors-1],5]),Last]]
In[]:=
CASymmetryTable[nColors_Integer]:=Sort[1+FromDigits[Extract[#,{{3,2},{2,3},{2,2},{2,1},{1,2}}],nColors]&/@#]&/@CASymmetryElements[nColors]
In[]:=
CASymmetryPlot[nColors_Integer]:=GraphicsRow[GraphicsGrid/@Partition[ArrayPlot[Normal@SparseArray[{{3,2}->#1,{2,3}->#2,{2,2}->#3,{2,1}->#4,{1,2}->#5}],ColorRules->Table[i->GrayLevel[1-i/(nColors-1)],{i,0,nColors-1}]]&@@@#&/@(IntegerDigits[#-1,nColors,5]&/@#&/@CASymmetryTable[nColors]),UpTo[32]]]
In[]:=
SymmetryInformation=Association@Table[With[{s=CASymmetryTable[i]},i-><|"nBits"->Length[s],"table"->s|>],{i,2,4}];
In[]:=
SymmetryInformation[2]
Out[]=
nBits12,table{{1},{2,3,9,17},{4,10,19,25},{5},{6,7,13,21},{8,14,23,29},{11,18},{12,20,26,27},{15,22},{16,24,30,31},{28},{32}}
In[]:=
FromDigitsSymmetric[digits_List,nColors_Integer]:=Block{s=SymmetryInformation[nColors,"table"],nBits=SymmetryInformation[nColors,"nBits"],ret},FromDigits[Function[{x,l,idx},Fold[ReplacePart[#1,(nColors^5-#2+1)->digits[[idx]]]&,x,l]],ConstantArray[0,nColors^5],s],nColors
In[]:=
SymmetricRuleToStandard[rule_Integer,nColors_Integer]:=FromDigitsSymmetric[IntegerDigits[rule,nColors,SymmetryInformation[nColors,"nBits"]],nColors]
In[]:=
SymmetricRuleToStandard[2,2]
Out[]=
134217728
Evolution
Evolution
Lifetime
Lifetime
In[]:=
Clear[Lifetime]
In[]:=
Lifetime[states_List]:=Block[{totals,pos},totals=ArrayReduce[Total,#,{1,2}]&/@states;pos=Position[totals,0,1,1];If[Length[pos]==0,Infinity,pos[[1,1]]-1]]
In[]:=
Lifetime[states_List]:=If[#==0,Infinity,Length[states]-#+1]&[LengthWhile[Reverse[states],Union[Flatten[#]]==={0}&]]
In[]:=
Lifetime[states_List,target_Integer]:=Block[{totals,pos},totals=ArrayReduce[Total,#,{1,2}]&/@states;pos=Position[totals,0,1,1];If[Length[pos]==0,Infinity,Abs[(pos[[1,1]]-1)-target]]]
In[]:=
LifetimeValue[nSteps_Integer][nColors_Integer][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->5,"Dimension"->2,"Colors"->nColors|>,CenterArray[1,{1,1}*(1+2nSteps)],nSteps]]
In[]:=
LifetimeValue[nSteps_Integer][{nColors_Integer,neig_}][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->neig,"Dimension"->2,"Colors"->nColors|>,{{{1}},0},nSteps]]
In[]:=
LifetimeValue[nSteps_Integer][{nColors_Integer,neig_,init_}][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->neig,"Dimension"->2,"Colors"->nColors|>,{init,0},nSteps]]
In[]:=
LifetimeValueProtected[nSteps_Integer][{nColors_Integer,neig_,init_}][rule_Integer]:=If[Total[Flatten[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->neig,"Dimension"->2,"Colors"->nColors|>,{init,0},{{30}}]]]>40,Infinity,Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->neig,"Dimension"->2,"Colors"->nColors|>,{init,0},nSteps]]]
In[]:=
LifetimeValueSymmetric[nSteps_Integer][nColors_Integer][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->SymmetricRuleToStandard[rule,nColors],"Neighborhood"->5,"Dimension"->2,"Colors"->nColors|>,CenterArray[1,{1,1}*(1+2nSteps)],nSteps]]
Loss Function
Loss Function
In[]:=
LifetimeLoss[nSteps_Integer,target_Integer][nColors_Integer][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->5,"Dimension"->2,"Colors"->nColors|>,CenterArray[1,{1,1}*(1+2nSteps)],nSteps],target]
In[]:=
LifetimeLoss[nSteps_Integer,target_Integer][{nColors_Integer,neig_}][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->neig,"Dimension"->2,"Colors"->nColors|>,{{{1}},0},nSteps],target]
In[]:=
LifetimeLoss[nSteps_Integer,target_Integer][{nColors_Integer,neig_,init_}][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->rule,"Neighborhood"->neig,"Dimension"->2,"Colors"->nColors|>,{init,0},nSteps],target]
In[]:=
LifetimeLossSymmetric[nSteps_Integer,target_Integer][nColors_Integer][rule_Integer]:=Lifetime[CellularAutomaton[<|"RuleNumber"->SymmetricRuleToStandard[rule,nColors],"Neighborhood"->5,"Dimension"->2,"Colors"->nColors|>,CenterArray[1,{1,1}*(1+2nSteps)],nSteps],target]
Mutation
Mutation
In[]:=
Mutate2DCARule[nColors_Integer][rule_Integer]:=Block[{digits,pos},digits=IntegerDigits[rule,nColors,nColors^5];pos=RandomInteger[{1,Length[digits]-1}];FromDigits[ReplacePart[digits,pos->Mod[digits[[pos]]+RandomInteger[{1,nColors-1}],nColors]],nColors]]
In[]:=
Mutate2DCARule[{nColors_Integer,neig_}][rule_Integer]:=Block[{digits,pos},digits=IntegerDigits[rule,nColors,nColors^neig];pos=RandomInteger[{1,Length[digits]-1}];FromDigits[ReplacePart[digits,pos->Mod[digits[[pos]]+RandomInteger[{1,nColors-1}],nColors]],nColors]]
In[]:=
Mutate2DCARuleSymmetric[nColors_Integer][rule_Integer]:=Block[{digits,pos},digits=IntegerDigits[rule,nColors,SymmetryInformation[nColors,"nBits"]];pos=RandomInteger[{2,Length[digits]}];FromDigits[ReplacePart[digits,pos->Mod[digits[[pos]]+RandomInteger[{1,nColors-1}],nColors]],nColors]]
Adaptation
Adaptation
In[]:=
Adapt2DCA[initRule_Integer,nColors_Integer,maxIters_Integer,lossFn_,mutateFn_]:=Block[{lossFun=lossFn[nColors],mutateFun=mutateFn[nColors]},NestWhileList[Block[{currentRule=#[[1]],currentLoss=#[[2]]},Block[{mutatedRule=mutateFun[currentRule],newLoss},newLoss=lossFun[mutatedRule];If[newLoss<=currentLoss,{mutatedRule,newLoss},#]]]&,{initRule,lossFun[initRule]},Last[#]>0&,1,maxIters]]
Experiments
Experiments
2D General 5 Neighbor
2D General 5 Neighbor
BIG OUTPUT: