MAIN CONTENT NOW SAVED AS SMWNets.nb
SMWNetwork[rule_,s_,n_]:=SMWToNet[Last[SMWEvolveListP[rule,s,n]]]
SMWToNet[list_]:=With[{u=Map[First,list]},MapIndexed[Function[{e,i},First[i]->((If[#==={},Infinity,#[[1,1]]]&[Position[u,#]])&/@Last[e])],list]]
ToListP[s_String]:=Map[{#,c++}&,Characters[s]]
SMWEvolveListP[rule_,s_,n_]:=Block[{c=1,events={}},{NestList[SMWStepP[rule,#]&,ToListP[s],n],Flatten[events]}]
SMWStepP[rule_,sp_]:=SMWStep1P[rule,sp,SMWFilter[StringPosition[StringJoin[Map[First,sp]],First/@rule]]]
SMWFilter[s_]:=Fold[If[Last[Last[#1]]>=First[#2],#,Append[#,#2]]&,{First[s]},Rest[s]]
SMWFilter[{}]={};
(The Partition[Flatten[ ]] is a complete hack...)
SMWStep1P[rule_,s_,pos_]:=Module[{a,b},a=Take[s,#]&/@pos;b=ToListP/@((StringJoin[First/@#]&/@a)/.rule);AppendTo[events,Apply[Rule,Map[Last,Transpose[{a,b}],{3}],{1}]];Partition[Flatten[ListReplacePart[s,b,Map[List,pos,{-1}]]],2]]
SMWStep1P[rule_,s_,{}]:=s
ListReplacePart::usage="ListReplacePart[list, {new1, new2, ... },{{m1, n1}, {m2, n2}, ... }] replaces elements at positions mithrough ni in list by newi.";
lrexpand[{f_,l_}]:=Map[Evaluate[Append[Drop[f,-1],#]]&,Range@@Last/@{f,l}]
(*replacespartsonebyone;canbebeautifiedaftermultipleassignmentinPartisfixed*)
ListReplacePart[list_List,new_List,pos_List]:=Module[{positions=lrexpand/@pos,result=list},Scan[(result[[Sequence@@First[#[[1]]]]]=#[[2]];Scan[(result[[Sequence@@#]]=Sequence[])&,Rest[#[[1]]]])&,Transpose[{positions,new}]];result]
SMWNetwork[{"ABA""BAAB","BBBB""AA"},"ABAAB",20]
{1{9,3,2,2},2{3,3,4,8},3{9,5,4,4},4{5,5,6,8},5{9,7,6,6},6{7,7,10,8},7{9,11,10,10},8{12,14},9{15,13},10{11,11,12,12},11{13,13,16,18},12{18,17,14,14},13{15,15,16,16},14{17,17,19,∞},15{∞,∞,∞,29},16{29,26,24,18},17{18,20,19,19},18{23,21},19{20,20,22,∞},20{21,21,22,22},21{23,23,25,∞},22{∞,∞,∞,∞},23{24,24,25,25},24{26,26,27,∞},25{∞,∞,∞,∞},26{29,28,27,27},27{28,28,30,∞},28{29,∞,30,30},29{∞,∞},30{∞,∞,∞,∞}}
NeighborCountsI[g_,i0_,n_]:=Map[If[MemberQ[#,Infinity],Infinity,Length[#]]&,Module[{gp=Dispatch[Prepend[g,∞->{∞}]]},NestList[Union[Flatten[{#,#/.gp}]]&,{i0},n]]]
SMWNetwork[{"ABA""BAAB","BBBB""AA"},"ABAAB",500];
NeighborCountsI[%,1,20]
{1,4,9,18,33,53,82,∞,∞,∞,∞,∞,∞,∞,∞,∞,∞,∞,∞,∞,∞}
Select[%,IntegerQ]
{1,4,9,18,33,53,82}
%479/RotateRight[%479]//N
{0.0121951,4.,2.25,2.,1.83333,1.60606,1.54717}
Suspect exponential growth.....