The rules for the multiway system can then be given for example as {"AAB"  "BB", "BA"  "ABB"} The evolution of the system is given by the functions MWStep[rule_List, slist_List] := Union[Flatten[ Map[Function[s, Map[MWStep1[#, s] &, rule]], slist]]] MWStep1[p_String  q_String, s_String] := Map[StringReplacePart[s, q, #] &, StringPosition[s, p]] MWEvolveList[rule_, init_List, t_Integer] := NestList[MWStep[rule, #] &, init, t] An alternative approach uses lists instead of strings, and in effect works by tracing the internal steps that Mathematica goes through in trying out possible matchings. With the rule from above written as {{x___, 0, 0, 1, y___}  {x, 1, 1, y}, {x___, 1, 0, y___}  {x, 0, 1, 1, y}} MWStep can be rewritten as MWStep[rule_List, slist_List] := Union[Flatten[Map[ReplaceList[#, rule] &, slist], 1]] The case shown on page 206 is {"AB"  "", "ABA"  "ABBAB", "ABABBB"  "AAAAABA"} starting with {"ABABAB"} . Note that the rules are set up so that a string for which there are no applicable replacements at a given step is simply dropped.

Substitution systems in which all replacements are done that are found to fit in a left-to-right scan can be implemented as follows GSSEvolveList[rule_, s_, n_] := NestList[GSSStep[rule, #] &, s, n] GSSStep[rule_, s_] := g[rule, s, f[StringPosition[s, Map[First, rule]]]] f[{ }] = { }; f[s_] := Fold[If[Last[Last[#1]] ≥ First[#2], #1, Append[#1, #2]]&, {First[s]}, Rest[s]] g[rule_, s_, { }] := s; g[rule_, s_, pos_] := StringReplacePart[ s, Map[StringTake[s, #] &, pos] /. rule, pos] with rules given as {"ABA"  "BAAB", "BBBB"  "AA"} .