Universal multiway system (UMS)
Universal multiway system (UMS)
I (dh) attempt to construct a universal multiway system. My idea is: the
rules and alphabet of the UMS are fixed; you feed in a chosen multiway
system (MWS) init string and rules all as a single init string for the UMS. The
UMS evolves this string, keeping the rules in there. A subset of resulting
strings of the UMS are the strings of the MWS.
rules and alphabet of the UMS are fixed; you feed in a chosen multiway
system (MWS) init string and rules all as a single init string for the UMS. The
UMS evolves this string, keeping the rules in there. A subset of resulting
strings of the UMS are the strings of the MWS.
Initial format is: -----PmTE--- R --- E ---R---E---R---E...---R---E
where the first ---- is A's and B's, and each ---R--- is something like
ABA->BB (the R is the arrow; the E separates two rules).
ABA->BB (the R is the arrow; the E separates two rules).
How it works:
1) The T goes right. If it gets to an E, it might turn into an X after
the E; this selects that rule.
the E; this selects that rule.
2) Meanwhile, the P goes left. At any point it might turn into a pQ;
that selects this position to apply the rule.
that selects this position to apply the rule.
3) The X checks the next character in the lhs of the rule and turns into
an x. If the character is an A, it sends a j to the left, otherwise it
sends a k to the left. When the j or k hit Q, if j and QjA there is a match, and
if k and QkB there is a match, so a J is sent to the right and Q is shifted
right; when the J hits x it turns it into X and the process continues.
an x. If the character is an A, it sends a j to the left, otherwise it
sends a k to the left. When the j or k hit Q, if j and QjA there is a match, and
if k and QkB there is a match, so a J is sent to the right and Q is shifted
right; when the J hits x it turns it into X and the process continues.
4) If the character after the X is an R (arrow), there is a complete
match and the rule can be applied. So the X turns into a Y and moves right,
turning A into C and B into D, until it hits E, in which case it turns into y
and moves left. The C and D move left also. When one of C,D,y hit Q, they
turn it into qAW or qBW or qy. The q kills A's and B's to the left of it
(removing the copy of the lhs) and then is killed by p; the W turns other C's and
D's into A's and B's; the y kills the W; when y hits p it turns into v and
moves right until it hits m, whence it turns into PmT and the process repeats
itself.
match and the rule can be applied. So the X turns into a Y and moves right,
turning A into C and B into D, until it hits E, in which case it turns into y
and moves left. The C and D move left also. When one of C,D,y hit Q, they
turn it into qAW or qBW or qy. The q kills A's and B's to the left of it
(removing the copy of the lhs) and then is killed by p; the W turns other C's and
D's into A's and B's; the y kills the W; when y hits p it turns into v and
moves right until it hits m, whence it turns into PmT and the process repeats
itself.
<<"MultiwaySystems\Multiway.m"
UMS={"AP"->"PA","BP"->"PB","P"->"pQ","TE"->"ET","TE"->"EX","TA"->"AT","TB"->"BT","TR"->"RT","XA"->"jAx","mj"->"jm","Aj"->"jA","Bj"->"jB","Rj"->"jR","Ej"->"jE","QjA"->"AQJ","JA"->"AJ","JB"->"BJ","JR"->"RJ","JE"->"EJ","Jm"->"mJ","Jx"->"X","XB"->"kBx","mk"->"km","Ak"->"kA","Bk"->"kB","Rk"->"kR","Ek"->"kE","QkB"->"BQJ","XR"->"RY","YA"->"CAY","YB"->"DBY","YE"->"yE","RC"->"CR","AC"->"CA","BC"->"CB","EC"->"CE","mC"->"Cm","RD"->"DR","AD"->"DA","BD"->"DB","ED"->"DE","mD"->"Dm","my"->"ym","Ay"->"yA","By"->"yB","Ry"->"yR","Ey"->"yE","QC"->"qAW","Qy"->"qy","QD"->"qBW","Aq"->"q","Bq"->"q","pq"->"p","WC"->"AW","WD"->"BW","Wy"->"y","py"->"v","vA"->"Av","vB"->"Bv","vm"->"PmT"};
Length[UMS]
60
Length@Union[Flatten[Apply[List,Map[Characters,UMS,{2}],{1}]]]
21
MWToUMS[rule_List,init_List]:=With[{r=StringJoin["PmTE",{#〚1〛,"R",#〚2〛,"E"}&/@rule,"Z"]},StringJoin[#,r]&/@init]
UMSFilter[hist_]:=StringTake[#,StringPosition[#,"PmT"]〚1,1〛-1]&/@Select[Flatten[hist],StringMatchQ[#,"*PmT*"]&]
UMSFilter[MWEvolveList[UMS,MWToUMS[{"A"->"AB","B"->"A"},{"A"}],200]]
{A,AB,ABB,AA,AAB,ABBB,ABA,AAB,AABB,ABAB,ABAB,AAA}
Looks good.
UMSFilter[MWEvolveList[UMS,MWToUMS[{"A"->"ABBA","BB"->""},{"A"}],200]]
{A,ABBA,ABBABBA,AA,ABBABBA,ABBABBABBA}
UMSFilter[MWEvolveList[UMS,MWToUMS[{""->"A"},{""}],100]]
{,A,AA,AA,AAA,AAA,AAA,AAA,AAAA,AAAA,AAAA,AAAA,AAAA,AAAAA,AAAA,AAAAA,AAAA}
For some reason none of the above works using XMWUEvolveList. Recursion
limit exceeded message.
limit exceeded message.
MWToUMS[{"A"->"AB","B"->"A"},{"A"}]
{APmTEARABEBRAEZ}
MWEvolveList[UMS,MWToUMS[{"A"->"AB","B"->"A"},{"A"}],5]
{{APmTEARABEBRAEZ},{APmETARABEBRAEZ,APmEXARABEBRAEZ,ApQmTEARABEBRAEZ,PAmTEARABEBRAEZ},{APmEATRABEBRAEZ,APmEjAxRABEBRAEZ,ApQmETARABEBRAEZ,ApQmEXARABEBRAEZ,PAmETARABEBRAEZ,PAmEXARABEBRAEZ,pQAmTEARABEBRAEZ},{APmEARTABEBRAEZ,APmjEAxRABEBRAEZ,ApQmEATRABEBRAEZ,ApQmEjAxRABEBRAEZ,PAmEATRABEBRAEZ,PAmEjAxRABEBRAEZ,pQAmETARABEBRAEZ,pQAmEXARABEBRAEZ},{APjmEAxRABEBRAEZ,APmEARATBEBRAEZ,ApQmEARTABEBRAEZ,ApQmjEAxRABEBRAEZ,PAmEARTABEBRAEZ,PAmjEAxRABEBRAEZ,pQAmEATRABEBRAEZ,pQAmEjAxRABEBRAEZ},{APmEARABTEBRAEZ,ApQjmEAxRABEBRAEZ,ApQmEARATBEBRAEZ,PAjmEAxRABEBRAEZ,PAmEARATBEBRAEZ,pQAmEARTABEBRAEZ,pQAmjEAxRABEBRAEZ}}
MWToUMS[{"A"->"ABBA","BB"->""},{"A"}]
{APmTEARABBAEBBREZ}
Length/@MWEvolveList[UMS,MWToUMS[{"A"->"AB","B"->"A"},{"A"}],50]
{1,4,7,8,8,7,7,8,9,9,10,10,7,5,5,5,6,7,8,10,12,14,16,17,18,18,18,17,16,13,11,9,7,5,4,3,3,2,1,1,1,1,1,4,8,11,12,11,11,12,13}
ListPlot[%,PlotJoinedTrue];
Length/@MWEvolveList[UMS,MWToUMS[{"A"->"AB","B"->"A"},{"A"}],300]
{1,4,7,8,8,7,7,8,9,9,10,10,7,5,5,5,6,7,8,10,12,14,16,17,18,18,18,17,16,13,11,9,7,5,4,3,3,2,1,1,1,1,1,4,8,11,12,11,11,12,13,13,14,14,12,9,7,6,5,4,5,6,7,9,11,13,15,18,19,21,22,22,23,24,23,22,20,18,16,15,13,12,11,11,10,9,7,7,6,6,5,5,7,11,15,17,16,16,17,18,22,27,29,28,25,22,20,21,20,21,20,18,15,14,16,19,22,26,31,37,43,50,56,60,65,68,69,70,67,64,60,56,50,45,39,35,30,25,21,19,16,14,15,18,20,22,20,20,24,31,39,49,53,52,51,53,57,63,66,63,59,57,53,52,58,62,65,67,69,72,75,80,89,94,98,102,106,110,116,119,122,125,130,130,134,132,130,125,123,115,110,107,108,107,107,102,99,92,89,93,101,105,101,92,90,89,92,98,106,104,101,105,115,127,145,162,170,183,196,210,232,255,264,273,280,280,283,286,292,296,302,300,301,298,300,299,299,300,304,304,306,311,316,322,326,325,325,334,341,361,377,386,384,375,368,370,378,389,383,368,353,348,348,357,375,381,382,392,410,432,461,487,501,523,545,570,600,642,670,688,714,745,772,812,841,861,885,912,924,944,973,993,1007,1021,1019,1020,1016,1017,1023,1042,1050}
ListPlot[%,PlotJoinedTrue];
