result=With[{raHeight=30,raWidth=20,rules={6,8},opts=Sequence["Radius"->1/2,"Orientation"->"Both","Neighborhood"->"Alternating","Appearance"->"Hexagonal"]},With[{raOpts=Sequence@@FilterRules[{opts},Options[RuleArray]]},With[{fn=(x|->Rescale[oneZeroOneOneFunction[Rescale[x,{1,raWidth},{-3,3}]],{0,1},{Floor[raWidth*1/4],Floor[raWidth*3/4]}]),finalStateFn=RuleArrayFinalState[raOpts]},Table[With[{seed=30498503+i},seed->Block[{res,resz},SeedRandom[seed];With[{loss=FunctionWithZerosLoss[fn]},With[{lossFn=loss[raHeight,raWidth,raOpts]},res=AdaptRuleArray[ConstantArray[2,{raHeight,raWidth}],rules,40000,lossFn,raOpts]]]]],{i,1,1}]]]];
GraphicsGrid[Partition[With[{raHeight=30,raWidth=20,rules={6,8},opts=Sequence["Radius"->1/2,"Orientation"->"Both","Neighborhood"->"Alternating","Appearance"->"Hexagonal"]},With[{raOpts=Sequence@@FilterRules[{opts},Options[RuleArray]]},With[{fn=(x|->Rescale[oneZeroOneOneFunction[Rescale[x,{1,raWidth},{-3,3}]],{0,1},{Floor[raWidth*1/4],Floor[raWidth*3/4]}]),finalStateFn=RuleArrayFinalState[raOpts]},With[{ruleArray=First[Last[Last[First[result]]]]},Table[With[{init=ReplacePart[Table[0,raWidth],x->1],target=ReplacePart[Table[0,raWidth],fn[x]->1]},With[{finalState=finalStateFn[init,IndicesToRules[ruleArray,rules],raHeight]},With[{pos=Position[finalState,1,1,1]},With[{y=If[Length[pos]==0,Infinity,First[First[pos]]]},Labeled[Show[ICAEvolutionPlot[raHeight,raWidth,ruleArray,rules,init,opts,Epilog->{EdgeForm[Directive[Blue,Thickness[1/60]]],FaceForm[None],BricksPlotDrawCell[OptionValue[{opts},"Appearance"],raHeight+1][raHeight+1,fn[x]],Splice@If[y!=Infinity,{EdgeForm[Directive[Red,Thickness[1/60]]],FaceForm[None],BricksPlotDrawCell[OptionValue[{opts},"Appearance"],raHeight+1][raHeight+1,y]},{}]}],ImageSize->{100,Automatic}],Text[NumberForm[N[#],2]]&/@{Rescale[x,{1,raWidth},{-3,3}],If[y===Infinity,"(no result)",Rescale[y,{Floor[raWidth*1/4],Floor[raWidth*3/4]},{0,1}]]},{Top,Bottom}]]]]],{x,1,raWidth}]]]]],UpTo[7]]]
Out[]=
In[]:=
result=With[{raHeight=30,raWidth=24,rules={6,8},opts=Sequence["Radius"->1/2,"Orientation"->"Both","Neighborhood"->"Alternating","Appearance"->"Hexagonal"]},With[{raOpts=Sequence@@FilterRules[{opts},Options[RuleArray]]},With[{fn=(x|->Rescale[oneZeroOneOneFunction[Rescale[x,{1,raWidth},{-3,3}]],{0,1},{Floor[raWidth*1/4],Floor[raWidth*3/4]}]),finalStateFn=RuleArrayFinalState[raOpts]},Table[With[{seed=30498503+i},seed->Block[{res,resz},SeedRandom[seed];With[{loss=FunctionWithZerosLoss[fn]},With[{lossFn=loss[raHeight,raWidth,raOpts]},res=AdaptRuleArray[ConstantArray[2,{raHeight,raWidth}],rules,40000,lossFn,raOpts]]]]],{i,1,1}]]]];
In[]:=
GraphicsGrid[Partition[With[{raHeight=30,raWidth=24,rules={6,8},opts=Sequence["Radius"->1/2,"Orientation"->"Both","Neighborhood"->"Alternating","Appearance"->"Hexagonal"]},With[{raOpts=Sequence@@FilterRules[{opts},Options[RuleArray]]},With[{fn=(x|->Rescale[oneZeroOneOneFunction[Rescale[x,{1,raWidth},{-3,3}]],{0,1},{Floor[raWidth*1/4],Floor[raWidth*3/4]}]),finalStateFn=RuleArrayFinalState[raOpts]},With[{ruleArray=First[Last[Last[First[result]]]]},Table[With[{init=ReplacePart[Table[0,raWidth],x->1],target=ReplacePart[Table[0,raWidth],fn[x]->1]},With[{finalState=finalStateFn[init,IndicesToRules[ruleArray,rules],raHeight]},With[{pos=Position[finalState,1,1,1]},With[{y=If[Length[pos]==0,Infinity,First[First[pos]]]},Labeled[Show[ICAEvolutionPlot[raHeight,raWidth,ruleArray,rules,init,opts,Epilog->{EdgeForm[Directive[Blue,Thickness[1/60]]],FaceForm[None],BricksPlotDrawCell[OptionValue[{opts},"Appearance"],raHeight+1][raHeight+1,fn[x]],Splice@If[y!=Infinity,{EdgeForm[Directive[Red,Thickness[1/60]]],FaceForm[None],BricksPlotDrawCell[OptionValue[{opts},"Appearance"],raHeight+1][raHeight+1,y]},{}]}],ImageSize->{100,Automatic}],Text[NumberForm[N[#],2]]&/@{Rescale[x,{1,raWidth},{-3,3}],If[y===Infinity,"(no result)",Rescale[y,{Floor[raWidth*1/4],Floor[raWidth*3/4]},{0,1}]]},{Top,Bottom}]]]]],{x,1,raWidth}]]]]],UpTo[7]]]
Evolution Plot
Evolution Plot
Successive functions, with their rule arrays above....