In what follows, rule_List is a list of the form {"AB""ABB,"C""BA"}, and slist_List and init_List are lists of the form {"ABB","BA","CAABAB"}.
The output of MWStep is the set of the results of single applications of the rules in rule_List to the strings in slist_List.
MWStep[rule_List,slist_List]:=Union[Flatten[Function[s,(MWStep1[#1,s]&)/@rule]/@slist]]
MWStep1[p_Stringq_String,s_String]:=(StringInsert[StringDrop[s,#1],q,First[#1]]&)/@StringPosition[s,p]
The output of MWEvolveList is a list of t+1 sets. The elements of the kth set are the strings that result from k-1 applications of the rules in rule_List to the strings in init_List.
MWEvolveList[rule_List,init_List,t_Integer/;NonNegative[t]]:=NestList[MWStep[rule,#1]&,init,t]
MWEvolve[rule_List,init_List,t_Integer/;NonNegative[t]]:=Nest[MWStep[rule,#1]&,init,t]
The output of MWStepT is the set of ordered pairs {x,y} where x is a string in slist_List and y is the result of a single application of a rule in rule_List to x.
MWStepT[rule_List,slist_List]:=Union[Flatten[Function[s,(MWStep1T[#1,s]&)/@rule]/@slist,2]]
MWStep1T[p_Stringq_String,s_String]:=({s,StringInsert[StringDrop[s,#1],q,First[#1]]}&)/@StringPosition[s,p]
MWStepTX[rule_List,slist_List,max_Integer]:=Union[Flatten[Function[s,(MWStep1TX[#1,s,max]&)/@rule]/@slist,2]]
MWStep1TX[p_Stringq_String,s_String,max_Integer]:=Select[({s,StringInsert[StringDrop[s,#1],q,First[#1]]}&)/@StringPosition[s,p],StringLength[#[[2]]]<max&]
The output of MWEvolveListT is a list of t+1 sets. The kth set is a set of ordered pairs {x,y} where x is the result of k-1 applications of rules in rule_List to a string in init_List, and y is the result of a single application of a rule in rule_List to x.
MWEvolveListT[rule_List,init_List,t_Integer/;NonNegative[t]]:=NestList[MWStepT[rule,Union[Last/@#1]]&,({#1,#1}&)/@init,t]
MWEvolveListTX[rule_List,init_List,t_Integer/;NonNegative[t],max_Integer]:=NestList[MWStepTX[rule,Union[Last/@#1],max]&,({#1,#1}&)/@init,t]
The output of MWRulesUsed is a list L where L[[i]] is the number of times the ith rule is used when executing MWStep[rule,slist].
MWRulesUsed[rule_List,slist_List]:=Function[x,Plus@@Length/@(StringPosition[#1,x]&)/@slist]/@First/@rule
In what follows, hist_ is the output to MWEvolveListT.
nodepos[hist_]:=Module[{nodes,np,nnp},nodes=Union[Flatten[hist]];np=({Position[hist,#1,∞,1]〚1,1〛,#1}&)/@nodes;nnp=Map[Last,Table[Cases[Sort[np],{n,_}],{n,Length[hist]}],{2}];(Position[nnp,#1,∞,1]〚1〛&)/@nodes]
nodeup[name_,{nodes_,np_}]:=np〚Position[nodes,name]〚1,1〛〛
MWNetGraphic[hist_]:=Module{np,nodes,arrows,selfarrows},np=nodepos[hist];nodes=Union[Flatten[hist]];arrows=Flatten[Map[{{1,-1}Reverse[nodeup[#1〚1〛,{nodes,np}]],{1,-1}Reverse[nodeup[#1〚2〛,{nodes,np}]]}&,hist,{2}],1];selfarrows=First/@Cases[arrows,{x_,x_}];arrows=DeleteCases[arrows,{x_,x_}];GraphicsAbsolutePointSize[.8],(Point[{1,-1}Reverse[#1]]&)/@np,Circle#1+0,,&/@selfarrows,(Arrow[#1,.2]&)/@arrows,AspectRatioAutomatic
1
4
1
4
rowblock makes a graphics object consisting of a string of size-1 colored squares, one for each character in the string s, with lower left-hand corner at position {x,y}. The colors of the squares are given in mwcolormap.
rowblock2[s_String,{x_,y_}]:=Table[EdgedRectangle[{i+x-1,y},{i+x,y+1},mwcolor[StringTake[s,{i}]],GrayStyle],{i,StringLength[s]}]
mwcolor[x_]:=If[MemberQ[First/@mwcolormap,x],x/.mwcolormap,Print["Missing entry in mwcolormap."];Abort[]]
mwcolormap={"A"GrayLevel[.85],"B"GrayLevel[0]};
These are the most current graphics routines. Again, hist_ is the output to MWEvolveListT.
MWGraphicNonMerged[hist_]:=Module{hh,rp,arrows,t1},hh=Map[Last,hist,{2}];rp=MapIndexed(#2〚2〛-1)1.2+StringLength[hh〚#2〚1〛,i〛],-4.4(#2〚1〛-1)&,hh,{2};arrows=FlattenTablet1=Position[Last/@hist〚y-1〛,hist〚y,x,1〛,1,1]1,1;rpy-1,t1+StringLength[hh〚y-1,t1〛],-.3,rpy,x+StringLength[hh〚y,x〛],1.3,{y,2,Length[hist]},{x,1,Length[hist〚y〛]},1;Graphics[{MapThread[rowblock2,{Flatten[hh,1],Flatten[rp,1]}],AbsoluteThickness[.3],(Arrow[#1,.5]&)/@arrows},AspectRatioAutomatic]
#2〚2〛-1
∑
i=1
1
2
1
2
MWStringSortQ[x_String,y_String]:=If[StringLength[x]==StringLength[y],OrderedQ[{x,y}],StringLength[x]<StringLength[y]]
MWGraphic[hist_]:=Module{hh,rp,arrows,t1,t2},hh=Sort[#,MWStringSortQ]&/@Union/@Map[Last,hist,{2}];rp=MapIndexed(#2〚2〛-1)1.2+StringLength[hh〚#2〚1〛,i〛],-4.4(#2〚1〛-1)&,hh,{2};arrows=FlattenTablet1=Position[hh〚y-1〛,hist〚y,x,1〛,1,1]1,1;t2=Position[hh〚y〛,hist〚y,x,2〛,1,1]1,1;rpy-1,t1+StringLength[hh〚y-1,t1〛],-.3,rpy,t2+StringLength[hh〚y,t2〛],1.3,{y,2,Length[hist]},{x,1,Length[hist〚y〛]},1;Graphics[{MapThread[rowblock2,{Flatten[hh,1],Flatten[rp,1]}],(Arrow[#1,.5,ArrowStyleAbsoluteThickness[.25]]&)/@arrows},AspectRatioAutomatic]
#2〚2〛-1
∑
i=1
1
2
1
2
MWGraphic[hist_,rightcutoff_:∞,opts___]:=Module{hh,rp,arrows,t1,t2,ellipses,hhc,rpc,arrowsc},hh=Sort[#,MWStringSortQ]&/@Union/@Map[Last,hist,{2}];rp=MapIndexed(#2〚2〛-1)1.2+StringLength[hh〚#2〚1〛,i〛],-4.4(#2〚1〛-1)&,hh,{2};rpc=Cases[#,{{x_,y_},{w_,z_}}/;x+StringLength[hh〚w,z〛]+If[z<Length[hh〚w〛],2.2,0]≤rightcutoff{x,y}]&/@MapIndexed[List,rp,{2}];hhc=MapIndexed[Take[#,Length[Extract[rpc,#2]]]&,hh];ellipses=Flatten[MapIndexed[If[Length[hh〚#2〚1〛〛]Length[#],{},{rp〚#2〚1〛,Length[#]+1〛}]&,hhc],1];arrows=FlattenTablet1=Position[hh〚y-1〛,hist〚y,x,1〛,1,1]1,1;t2=Position[hh〚y〛,hist〚y,x,2〛,1,1]1,1;rpy-1,t1+StringLength[hh〚y-1,t1〛],-.3,rpy,t2+StringLength[hh〚y,t2〛],1.3,{y,2,Length[hist]},{x,1,Length[hist〚y〛]},1;arrowsc=Cases[arrows,{{w_,x_},{y_,z_}}/;w≤rightcutoff||y≤rightcutoffIf[w>rightcutoff,Arrow[{{rightcutoff,z+(x-z)(rightcutoff-y)/(w-y)},{y,z}},.5,ArrowStyleAbsoluteThickness[.25]],If[y>rightcutoff,Line[{{w,x},{rightcutoff,x+(z-x)(rightcutoff-w)/(y-w)}}],Arrow[{{w,x},{y,z}},.5,ArrowStyleAbsoluteThickness[.25]]]]];Graphics[{MapThread[rowblock2,{Flatten[hhc,1],Flatten[rpc,1]}],{AbsolutePointSize[.5],GrayLevel[0],Point[#+{0,.5}],Point[#+{.5,.5}],Point[#+{1,.5}]}&/@ellipses,arrowsc},opts,AspectRatioAutomatic]
#2〚2〛-1
∑
i=1
1
2
1
2
MWCharRuleGraphic[rule_List]:=GraphicsRow[(MWRG2[First[#1],Last[#1]]&)/@rule,0]
MWRG2[s0_String,s1_String]:=Graphics[{Table[{EdgedRectangle[{i,0},{i+1,1},mwcolor[StringTake[s0,{i}]],GrayStyle],GrayLevel[0]},{i,StringLength[s0]}],Table[EdgedRectangle[{i,-2},{i+1,-1},mwcolor[StringTake[s1,{i}]],GrayStyle],{i,StringLength[s1]}],{AbsoluteThickness[.25],GrayLevel[0],Line[{{1,0},{1,-1}}],Line[{{StringLength[s0]+1,0},{StringLength[s1]+1,-1}}]}},AspectRatioAutomatic,PlotRange{{0,Max[StringLength[s1],StringLength[s0]]+2},{-2.6,1.6}},FrameTrue,FrameTicksNone,FrameStyleHairlineStyle]
MWCharRuleGraphic[rule_List]:=FramedGraphicsRow[(MWRG2[First[#1],Last[#1]]&)/@rule]
MWRG2[s0_String,s1_String]:=Graphics[{Table[{EdgedRectangle[{i,0},{i+1,1},mwcolor[StringTake[s0,{i}]],GrayStyle],GrayLevel[0]},{i,StringLength[s0]}],Table[EdgedRectangle[{i,-2},{i+1,-1},mwcolor[StringTake[s1,{i}]],GrayStyle],{i,StringLength[s1]}],{AbsoluteThickness[0.25],GrayLevel[0],Line[{{1,0},{1,-1}}],Line[{{StringLength[s0]+1,0},{StringLength[s1]+1,-1}}]}},AspectRatioAutomatic,PlotRange{{0,Max[StringLength[s1],StringLength[s0]]+2},{-2.96,1.96}},FrameFalse,FrameTicksNone,FrameStyleHairlineStyle]
These are now obsolete. Replace MWEvolGraphicNonMerged with MWGraphicNonMerged and MWEvolGraphic with MWGraphic, and change their input from (FromChars[output of MWEvolveListT]) to (output of MWEvolveListT).
MWEvolGraphicNonMerged[hist_]:=Module{hh,rp,arrows,t1},hh=Map[Last,hist,{2}];rp=MapIndexed(#2〚2〛-1)1.2+Length[hh〚#2〚1〛,i〛],-4.4(#2〚1〛-1)&,hh,{2};arrows=FlattenTablet1=Position[Last/@hist〚y-1〛,hist〚y,x,1〛,1,1]1,1;rpy-1,t1+Length[hh〚y-1,t1〛],-.3,rpy,x+Length[hh〚y,x〛],1.3,{y,2,Length[hist]},{x,1,Length[hist〚y〛]},1;Graphics[{MapThread[rowblock,{Flatten[hh,1],Flatten[rp,1]}],AbsoluteThickness[.3],(Arrow[#1,.5]&)/@arrows},AspectRatioAutomatic]
#2〚2〛-1
∑
i=1
1
2
1
2
MWEvolGraphic[hist_]:=Module{hh,rp,arrows,t1,t2},hh=Union/@Map[Last,hist,{2}];rp=MapIndexed(#2〚2〛-1)1.2+Length[hh〚#2〚1〛,i〛],-4.4(#2〚1〛-1)&,hh,{2};arrows=FlattenTablet1=Position[hh〚y-1〛,hist〚y,x,1〛,1,1]1,1;t2=Position[hh〚y〛,hist〚y,x,2〛,1,1]1,1;rpy-1,t1+Length[hh〚y-1,t1〛],-.3,rpy,t2+Length[hh〚y,t2〛],1.3,{y,2,Length[hist]},{x,1,Length[hist〚y〛]},1;Graphics[{MapThread[rowblock,{Flatten[hh,1],Flatten[rp,1]}],(Arrow[#1,.5,ArrowStyleAbsoluteThickness[.25]]&)/@arrows},AspectRatioAutomatic]
#2〚2〛-1
∑
i=1
1
2
1
2
These are now obsolete. MWCharGrowth is replaced with XMWTotalList (same input). FromChars is used to create input to various other obsolete routines.
These are now obsolete. Replace MWRuleGraphic with MWCharRuleGraphic and change its input from (FromChars[rule]) to (rule). Then someday when MWRuleGraphic no longer exists, change the name of MWCharRuleGraphic to MWRuleGraphic. (Note that the parameter k in MWRuleGraphic doesn't do anything, so delete it.)
I don't know about the rest of this stuff.
(** What follows is older material **)
(* NetworkStep does replacements in parallel at all possible points in the
list; NetworkFrontStep does only the first such replacement, for each of the
possible replacements. *)
(** The latter is effectively a multipath SSS **)
(* NetworkStep does replacements in parallel at all possible points in the
list; NetworkFrontStep does only the first such replacement, for each of the
possible replacements. *)
(** The latter is effectively a multipath SSS **)
Bit-packed multiway code
Bit-packed multiway code
This is a crude wrapper to MWBitsX (the MathLink C function) which doesn't process its output.
This function outputs all of the new strings at each level. (The U stands for "unique", signifying that only new strings are output, rather than all the strings.)
This function outputs the new strings too, except they are given in bits form instead of string form.
This function outputs a list of the lengths of the new strings at each level.
This function outputs the lengths of the new strings at each level in the form {length, number of strings with that length}.
This function outputs the total number of new strings at each level.
This function outputs at each level a list of the form {{list of new strings of length <= maxlen},total # of new strings, {min length of new strings, max length of new strings}} (with the last element of the list occurring only if there are new strings).
Wrapper Functions for SW Code
Wrapper Functions for SW Code
Unique String Utilities
Unique String Utilities