WOLFRAM NOTEBOOK

In[]:=
SREvolveCN0[rewrite_,{ic_,eventls_,ind_}]:=With[{diff=#2-#1&@@(StringLength/@rewrite),rhslen=StringLength[rewrite[[2]]],positions=StringPosition[ic,rewrite[[1]]]},With[{difflist=MapIndexed[{ind+#2[[1]],#+(#2[[1]]-1)diff}&,positions]},{Flatten[MapIndexed[Thread[#(#2[[1]]+ind)]&,Take[eventls,#]&/@positions]],StringReplace[ic,rewrite],Fold[Join[Take[#,#2[[2,1]]-1],Table[#2[[1]],{rhslen}],Drop[#,#2[[2,2]]]]&,eventls,difflist],ind+Length[difflist]}]]
In[]:=
SREvolveCN1[rule_,{ic_,eventls_,ind_}]:=Fold[Join[Drop[#,-3],SREvolveCN0[#2,Take[#,-3]]]&,{ic,eventls,ind},rule]
In[]:=
SREvolveCN2[rule_,{ic_,eventls_,ind_}]:=FoldList[SREvolveCN0[#2,Rest[#]]&,{{},ic,eventls,ind},rule]
In[]:=
SREvolveCN[rule_List,init_,t_]:=Rest[Drop[#,-3]&/@NestList[SREvolveCN1[rule,Take[#,-3]]&,{{},init,Array[(1)&,StringLength[init]],1},t]]
In[]:=
SREvolveCN[rule_Rule,init_,t_]:=SREvolveCN[{rule},init,t]
In[]:=
SREvolveCN[{"AB"->"BAAAB"},"AB",8]
Out[]=
In[]:=
Graph[Flatten[%]]
Out[]=
In[]:=
LayeredGraphPlot[%]
Out[]=
In[]:=
Graph[Flatten[SREvolveCN[{"A""BB","B""A"},"A",8]]]
Out[]=
In[]:=
Graph[Flatten@SREvolveCN[{"A""CAB","BBBC""CBB"},"AA",50]]
Out[]=
Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.