<<"MultiwaySystems/Multiway.m";
mkrule[rule_]:=ToCharsX[(#1/.({a_,b_}{c_,d_}){a,-1,-1,b}{-1,c,d,-1}&)/@rule]
ToCharsX[rule_]:=rule/.x:{___Integer}StringJoin@@(x/.{0"A",1"B",-1"-"})
{{1,1}{0,0},{1,0}{1,1},{0,1}{1,1},{0,0}{0,0}}
{{1,1}{0,0},{1,0}{1,1},{0,1}{1,1},{0,0}{0,0}}
mkrule[%2]
{B--B-AA-,B--A-BB-,A--B-BB-,A--A-AA-}
ToCharsX[ReplacePart[Rest[Rest[Flatten[Table[{0,0,-1,-1},{6}]]]],1,{{11},{12}}]]
--AA--AA--BB--AA--AA--
XMWUEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{"--AA--AA--BB--AA--AA--"},15]
{{--AA--AA--BB--AA--AA--},{--A-AA-A--BB--AA--AA--,--AA--A-BB-B--AA--AA--,--AA--AA--B-BB-A--AA--,--AA--AA--BB--A-AA-A--},{--A-AA--BB-B--AA--AA--,--A-AA-A--B-BB-A--AA--,--A-AA-A--BB--A-AA-A--,--AA--A-BB--BB-A--AA--,--AA--A-BB-B--A-AA-A--,--AA--AA--B-BB--AA-A--},{--A-A-BB-B-B--AA--AA--,--A-AA--BB--BB-A--AA--,--A-AA--BB-B--A-AA-A--,--A-AA-A--B-BB--AA-A--,--AA--A-B-AA-B-A--AA--,--AA--A-BB--BB--AA-A--,--AA--AA--B-B-BB-A-A--},{--A-A-BB-B--BB-A--AA--,--A-A-BB-B-B--A-AA-A--,--A-AA--B-AA-B-A--AA--,--A-AA--BB--BB--AA-A--,--A-AA-A--B-B-BB-A-A--,--AA--A-B-AA-B--AA-A--,--AA--A-BB--B-BB-A-A--},{--A-A-BB--AA-B-A--AA--,--A-A-BB-B--BB--AA-A--,--A-AA--B-AA-B--AA-A--,--A-AA--BB--B-BB-A-A--,--AA--A-B-AA--BB-A-A--},{--A-A-B-BB-A-B-A--AA--,--A-A-BB--AA-B--AA-A--,--A-A-BB-B--B-BB-A-A--,--A-AA--B-AA--BB-A-A--,--AA--A-B-A-BB-B-A-A--},{--A-A-B-BB-A-B--AA-A--,--A-A-BB--AA--BB-A-A--,--A-AA--B-A-BB-B-A-A--},{--A-A-B-BB-A--BB-A-A--,--A-A-BB--A-BB-B-A-A--},{--A-A-B-BB--BB-B-A-A--},{--A-A-B-B-AA-B-B-A-A--},{},{},{},{},{}}
Length[%]
11
Length/@%11
{1,4,6,7,7,5,5,3,2,1,1}
mkinit[len_]:=ToCharsX[ReplacePart[Rest[Rest[Flatten[Table[{0,0,-1,-1},{len}]]]],1,{{2len-1},{2len}}]]
General::spell1:Possible spelling error: new symbol name "ToCharsX is similar to existing symbol ToChars.
mkinit[6]
--AA--AA--BB--AA--AA--
mkinit[10]
--AA--AA--AA--AA--BB--AA--AA--AA--AA--
XMWUEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{%},15]
Length/@%
{1,8,28,63,112,167,219,268,303,326,338,338,331,314,293,268}
XMWUEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{%18},2]
DashesOKQ[string_]:=With[{c=Flatten/@Transpose[Partition[Partition[Characters[string],2],2]]},Union[First[c]]{"-"}&&Union[Last[c]]{"A","B"}]
DashesOKQ[mkinit[10]]
True
DashesOKQ[mkinit[9]]
False
Select[#,DashesOKQ]&/@%19
{{--AA--AA--AA--AA--BB--AA--AA--AA--AA--},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{}}
Select[#,DashesOKQ]&/@XMWUEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{"--AA--AA--BB--AA--AA--"},15]
{{--AA--AA--BB--AA--AA--},{},{},{},{},{},{},{},{},{},{},{},{},{},{},{}}
XMWUEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{"--AA--AA--BB--AA--AA--"},5]
{{--AA--AA--BB--AA--AA--},{--A-AA-A--BB--AA--AA--,--AA--A-BB-B--AA--AA--,--AA--AA--B-BB-A--AA--,--AA--AA--BB--A-AA-A--},{--A-AA--BB-B--AA--AA--,--A-AA-A--B-BB-A--AA--,--A-AA-A--BB--A-AA-A--,--AA--A-BB--BB-A--AA--,--AA--A-BB-B--A-AA-A--,--AA--AA--B-BB--AA-A--},{--A-A-BB-B-B--AA--AA--,--A-AA--BB--BB-A--AA--,--A-AA--BB-B--A-AA-A--,--A-AA-A--B-BB--AA-A--,--AA--A-B-AA-B-A--AA--,--AA--A-BB--BB--AA-A--,--AA--AA--B-B-BB-A-A--},{--A-A-BB-B--BB-A--AA--,--A-A-BB-B-B--A-AA-A--,--A-AA--B-AA-B-A--AA--,--A-AA--BB--BB--AA-A--,--A-AA-A--B-B-BB-A-A--,--AA--A-B-AA-B--AA-A--,--AA--A-BB--B-BB-A-A--},{--A-A-BB--AA-B-A--AA--,--A-A-BB-B--BB--AA-A--,--A-AA--B-AA-B--AA-A--,--A-AA--BB--B-BB-A-A--,--AA--A-B-AA--BB-A-A--}}
Select[#,DashesOKQ]&/@MWEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{"--AA--AA--BB--AA--AA--"},5]
{{--AA--AA--BB--AA--AA--},{},{},{},{},{}}
ToCharsX[ReplacePart[Flatten[Table[{0,0,-1,-1},{5}]],1,{{9},{10}}]]
AA--AA--BB--AA--AA--
Select[#,DashesOKQ]&/@MWEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{%},5]
{{},{},{},{},{},{}}
MWEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{"AA--AA--BB--AA--AA"},5]
{{AA--AA--BB--AA--AA},{A-AA-A--BB--AA--AA,AA--AA--BB--A-AA-A,AA--AA--B-BB-A--AA,AA--A-BB-B--AA--AA},{A-AA-A--BB--A-AA-A,A-AA-A--B-BB-A--AA,AA--AA--B-BB--AA-A,A-AA--BB-B--AA--AA,AA--A-BB-B--A-AA-A,AA--A-BB--BB-A--AA},{A-AA-A--B-BB--AA-A,AA--AA--B-B-BB-A-A,AA--A-B-AA-B-A--AA,A-AA--BB-B--A-AA-A,A-AA--BB--BB-A--AA,AA--A-BB--BB--AA-A,A-A-BB-B-B--AA--AA},{A-AA-A--B-B-BB-A-A,A-AA--B-AA-B-A--AA,AA--A-B-AA-B--AA-A,A-AA--BB--BB--AA-A,AA--A-BB--B-BB-A-A,A-A-BB-B-B--A-AA-A,A-A-BB-B--BB-A--AA},{A-AA--B-AA-B--AA-A,AA--A-B-AA--BB-A-A,A-AA--BB--B-BB-A-A,A-A-BB--AA-B-A--AA,A-A-BB-B--BB--AA-A}}
Select[#,DashesOKQ]&/@MWEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{%},5]
MWEvolveList[{"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-"},{"AA--BB--AA--"},5]
{{AA--BB--AA--},{AA--B-BB-A--,A-BB-B--AA--},{A-BB--BB-A--},{A-B-AA-B-A--},{},{}}
endedrules={"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-","L""LAA--","R""--AAR"};
mkinit[2]
--BB--
XMWUEvolveList[endedrules,{"LBBR"},4]
{{LBBR},{LAA--BBR,LBB--AAR},{LAA--AA--BBR,LA-BB-BR,LAA--BB--AAR,LB-BB-AR,LBB--AA--AAR},{LAA--AA--AA--BBR,LA-AA-A--BBR,LAA--A-BB-BR,LAA--AA--BB--AAR,LA-BB-B--AAR,LAA--B-BB-AR,LAA--BB--AA--AAR,LB-BB-A--AAR,LBB--A-AA-AR,LBB--AA--AA--AAR},{LAA--AA--AA--AA--BBR,LA-AA-A--AA--BBR,LAA--A-AA-A--BBR,LAA--AA--A-BB-BR,LAA--AA--AA--BB--AAR,LA-AA--BB-BR,LA-AA-A--BB--AAR,LAA--A-BB-B--AAR,LAA--AA--B-BB-AR,LAA--AA--BB--AA--AAR,LA-BB--BB-AR,LA-BB-B--AA--AAR,LAA--B-BB-A--AAR,LAA--BB--A-AA-AR,LAA--BB--AA--AA--AAR,LB-BB--AA-AR,LB-BB-A--AA--AAR,LBB--A-AA-A--AAR,LBB--AA--A-AA-AR,LBB--AA--AA--AA--AAR}}
StateOKQ[string_]:=With[{c=Flatten/@Transpose[Partition[Partition[Characters[StringTake[string,{2,-2}]],2],2]]},Union[Last[c]]{"-"}&&Union[First[c]]{"A","B"}]
Select[#,StateOKQ]&/@%39
Transpose::nmtx:The first two levels of the one-dimensional list {} cannot be transposed.
Transpose::nmtx:The first two levels of the one-dimensional list {} cannot be transposed.
{{},{},{LAA--BB--AAR,LBB--AA--AAR},{LAA--AA--BB--AAR,LAA--BB--AA--AAR,LBB--AA--AA--AAR},{LAA--AA--AA--BB--AAR,LAA--AA--BB--AA--AAR,LAA--BB--AA--AA--AAR,LBB--AA--AA--AA--AAR}}
dhrules={"B--B""-AA-","B--A""-BB-","A--B""-BB-","A--A""-AA-","---A-""---AA--","-A---""--AA---"};
mkinit[4]
--AA--BB--AA--
"---AA--BB--AA---"
XMWUEvolveList[dhrules,{"---AA--BB--AA---"},4]
{{---AA--BB--AA---},{---A-BB-B--AA---,---AA--B-BB-A---},{---AA--BB-B--AA---,---A-BB--BB-A---,---AA--B-BB--AA---},{---A-BB-B-B--AA---,---AA--BB--BB-A---,---A-B-AA-B-A---,---A-BB--BB--AA---,---AA--B-B-BB-A---},{---AA--BB-B-B--AA---,---A-BB-B--BB-A---,---AA--B-AA-B-A---,---AA--BB--BB--AA---,---A-B-AA-B--AA---,---A-BB--B-BB-A---,---AA--B-B-BB--AA---}}
DashesOK2Q[string_]:=With[{c=Flatten/@Transpose[Partition[Partition[Characters[StringTake[string,{2,-2}]],2],2]]},Union[First[c]]{"-"}&&Union[Last[c]]{"A","B"}]
Select[#,DashesOK2Q]&/@XMWUEvolveList[dhrules,{"---AA--BB--AA---"},10]
{{---AA--BB--AA---},{},{},{},{---AA--BB--BB--AA---},{},{},{},{},{---AA--BB--AA--BB--AA---},{}}
Select[#,DashesOK2Q]&/@XMWUEvolveList[dhrules,{"---AA--BB--AA---"},15]
{{---AA--BB--AA---},{},{},{},{---AA--BB--BB--AA---},{},{},{},{},{---AA--BB--AA--BB--AA---},{},{},{},{},{},{---AA--BB--BB--BB--BB--AA---}}
Select[#,DashesOK2Q]&/@MWEvolveList[dhrules,{"---AA--BB--AA---"},6]
{{---AA--BB--AA---},{},{},{},{---AA--BB--BB--AA---},{},{}}