About Multiway Systems
About Multiway Systems
The basic multiway evolution functions
The basic multiway evolution functions
(Depressingly long in my opinion; most of my book's programs are really short.)
MWEvolveList[rule_,init_List,t_Integer]:=NestList[MWStep[rule,#]&,init,t]
MWStep[rule_List,slist_List]:=Union[Flatten[Function[s,(MWStep1[#1,s]&)/@rule]/@slist]]
MWStep1[p_Stringq_String,s_String]:=(StringReplacePart[s,q,#1]&)/@StringPosition[s,p]
Basic examples
Basic examples
(The pictures require all sorts of book code to generate, not extricated here.)
A trivial multiway system:
MWEvolveList[{"A""A","A""AA"},{"A"},5]
{{A},{A,AA},{A,AA,AAA},{A,AA,AAA,AAAA},{A,AA,AAA,AAAA,AAAAA},{A,AA,AAA,AAAA,AAAAA,AAAAAA}}
The "Fibonacci" multiway system:
MWEvolveList[{"A""AB","B""A"},{"A"},5]
{{A},{AB},{AA,ABB},{AAB,ABA,ABBB},{AAA,AABB,ABAB,ABBA,ABBBB},{AAAB,AABA,AABBB,ABAA,ABABB,ABBAB,ABBBA,ABBBBB}}
A somewhat less trivial example:
MWEvolveList[{"AA""","BA""ABB","BB""A"},{"BBA"},5]
{{BBA},{AA,BABB},{,ABBBB,BAA},{AABB,ABAB,ABBA,B},{AAA,AABBB,ABABB,BB},{A,AAAB,AABA,AABBBB,ABAA,BBB}}
Show[Surround[MWGraphic[MWEvolveListT[{"AA""","BA""ABB","BB""A"},{"BBA"},15]]]];
A considerably less trivial example:
MWEvolveList[{"ABA""ABBAB","AB""","ABABBB""AAAAABA"},{"ABABAB"},5]
{{ABABAB},{ABAB,ABABBABB,ABBABBAB},{AB,ABABBB,ABBABB,ABBABBBABB,ABBBAB,BABBAB},{,AAAAABA,ABBABBBB,ABBB,ABBBBABB,BABB,BABBBABB,BBAB},{AAAAA,AAAAABBAB,ABBBBB,BABBBB,BB,BBBABB},{AAAAABB,AAAABAB,BBBB}}
Show[Surround[MWGraphic[MWEvolveListT[{"ABA""ABBAB","AB""","ABABBB""AAAAABA"},{"ABABAB"},20]]]];
Length/@MWEvolveList[{"ABA""ABBAB","AB""","ABABBB""AAAAABA"},{"ABABAB"},100]
{1,3,6,8,6,3,2,3,2,3,4,5,5,5,4,2,3,4,5,5,6,6,5,4,4,5,5,6,6,6,6,7,6,5,6,6,6,7,8,8,8,7,6,6,7,8,9,9,9,9,7,7,8,9,10,10,10,9,10,9,9,10,10,11,10,11,11,12,11,10,11,11,12,12,13,13,13,12,11,12,13,14,14,14,14,14,13,13,15,15,15,15,15,15,16,16,15,16,16,16,16}
Lengths of strings derived after t steps:
Complete and consistent examples
Complete and consistent examples
If negation preserves string length, exactly half the strings of a given length should get generated.
MWEvolveList[{"A""AA","A""AB"},{"A"},4]
{{A},{AA,AB},{AAA,AAB,ABA,ABB},{AAAA,AAAB,AABA,AABB,ABAA,ABAB,ABBA,ABBB},{AAAAA,AAAAB,AAABA,AAABB,AABAA,AABAB,AABBA,AABBB,ABAAA,ABAAB,ABABA,ABABB,ABBAA,ABBAB,ABBBA,ABBBB}}
MWEvolveList[{"A""AB","A""BA","BA""BAA"},{"A"},4]
{{A},{AB,BA},{ABB,BAA,BAB,BBA},{ABBB,BAAA,BAAB,BABA,BABB,BBAA,BBAB,BBBA},{ABBBB,BAAAA,BAAAB,BAABA,BAABB,BABAA,BABAB,BABBA,BABBB,BBAAA,BBAAB,BBABA,BBABB,BBBAA,BBBAB,BBBBA}}
Often it can take a while for all the "true" strings of a given length to appear:
MWEvolveList[{"A""AA","AAA""AB","B""AAB"},{"A"},6]
{{A},{AA},{AAA},{AAAA,AB},{AAAAA,AAAB,AAB,ABA},{AAAAAA,AAAAAB,AAAAB,AAAB,AAABA,AABA,ABAA,ABB},{AAAAAAA,AAAAAAAB,AAAAAAB,AAAAAB,AAAAABA,AAAAB,AAAABA,AAABA,AAABAA,AAABB,AABAA,AABAB,AABB,ABAAA,ABAAB,ABAB,ABB,ABBA}}
Other things
Other things
A rule with the Church-Rosser property:
MWEvolveList[{"AB""BA","BBA""BAAB"},{"ABAAB"},4]
{{ABAAB},{ABABA,BAAAB},{ABBAA,BAABA},{ABAABA,BABAA},{ABABAA,BAAABA,BBAAA}}
Show[Surround[MWGraphic[MWEvolveListT[{"AB""BA","BBA""BAAB"},{"ABAAB"},10]]]];
Makanin's group:
mak=Join[#,Map[Reverse,#]]&["CCBB"->"BBCC", "BCCCBB"->"CBBBCC","ACCBB"->"BBA", "ABCCCBB"->"CBBA","BBCCBBBBCC"->"BBCCBBBBCCA"]
The first string where something non-trivial (though not very) happens: