allg1=Cases[Catenate[allres],(x_n_)/;n>1x]
In[]:=
Out[]=
findCanonicalCriticalPairs/@{{"AB""A","BA""ABB"},{"AB""A","BA""BAB"}}
In[]:=
{{{AA,AA},{AA,AABB},{AABB,AABB},{ABBB,ABBB},{ABBB,BA},{BA,BA}},{{AA,AA},{AA,ABAB},{ABAB,ABAB},{BA,BA},{BA,BABB},{BABB,BABB}}}
Out[]=
MultiwaySystem[{"AB""A","BA""BAB"},{"BA","BABB"},4,"EvolutionGraph"]
In[]:=
Out[]=
MultiwaySystem[{"AB""A","BA""BAB"},{"BA","BABB"},4,"EvolutionGraph"]
ParallelMapMonitored[#TimeConstrained[Do[If[TotalCausalInvariantQ[#,t],Return[t]],{t,7}],2]&,EnumerateSubstitutionSystemRules[Echo@#,2]]&/@Drop[allsigs,20]
Function[r,r(#->Do[If[ConvergentCriticalPairQ[r,#,t],Return[t]],{t,7}])&/@DeleteCases[findCanonicalCriticalPairs[r],{x_,x_}]]/@allg1
In[]:=
Out[]=
Function[r,r(#->Do[If[ConvergentCriticalPairQ[r,#,t],Return[t]],{t,7}])&/@Select[DeleteCases[findCanonicalCriticalPairs[r],{x_,x_}],StringLength[#[[1]]]>1&&StringLength[#[[2]]]>1&&ContainsAll[VertexList[MultiwaySystem[r,#,1,"StatesGraph"]],#]&]]/@allg1
In[]:=
Out[]=
bigr=%248;
In[]:=
Cases[Catenate[bigr],(x_y_4)(xy)]
In[]:=
{{AAA,ABAAB}{AA,BAAB},{AAA,ABABB}{AA,BABB},{AAA,AABAB}{AAA,BAB},{AAAB,AABA}{AABA,BA}}
Out[]=
LayeredGraphPlot[MultiwaySystem[First[#],Last[#],4,"StatesGraph"]]&/@%
In[]:=
Out[]=
sg=MultiwaySystem[{"A""AA","AA""BAB"},{"AAA","BAB"},4,"StatesGraph"]
In[]:=
Out[]=
Intersection[Flatten@MultiwaySystem[{"A""AA","AA""BAB"},"AAA",4],Flatten@MultiwaySystem[{"A""AA","AA""BAB"},"BAB",4]]
In[]:=
{BABABAB}
Out[]=
FindShortestPath[sg,"AAA","BABABAB"]
In[]:=
{AAA,AAAA,AAAAA,AAABAB,BABABAB}
Out[]=
FindShortestPath[sg,"BAB","BABABAB"]
In[]:=
{BAB,BAAB,BAAAB,BAAAAB,BABABAB}
Out[]=
GraphUnion[PathGraph[{"AAA","AAAA","AAAAA","AAABAB","BABABAB"},DirectedEdgesTrue],PathGraph[{"BAB","BAAB","BAAAB","BAAAAB","BABABAB"},DirectedEdgesTrue]]
In[]:=
Out[]=
Subgraph[sg,%]
In[]:=
Out[]=
HighlightGraphMultiwaySystem[{"A""AA","AA""BAB"},{"AAA","BAB"},4,"StatesGraphStructure"],
In[]:=
Out[]=
Rule@@@Partition[{"AAA","AAAA","AAAAA","AAABAB","BABABAB"},2,1]
In[]:=
{AAAAAAA,AAAAAAAAA,AAAAAAAABAB,AAABABBABABAB}
Out[]=
Rule@@@Partition[{"AAA","AAAA","AAAAA","AAABAB","BABABAB"},2,1]
NeighborhoodGraph[sg,"AAA",4]
In[]:=
Out[]=
Cases[Catenate[bigr],(x_y_3)(xy)]
In[]:=
Out[]=
InteractiveListSelectorSW[LayeredGraphPlot[MultiwaySystem[First[#],Last[#],3,"StatesGraphStructure"]]#&/@%262]
In[]:=
Out[]=
LayeredGraphPlot[MultiwaySystem[First[#],Last[#],3,"StatesGraph"]]&/@{{"A""AA","AAB""BA"}{"AAAB","BA"},{"A""AAA","AB""BA"}{"AAAB","BA"}}
In[]:=
Out[]=
Take[Catenate[bigr],4]
In[]:=
{{AAA,ABAB}{AA,BAB}3,{AAA,ABAB}{AABA,ABAA}1,{AAAB,AAA}{AAAB,AABA}1,{AAA,ABBA}{AAB,BA}2}
Out[]=
Select[Catenate[bigr],AllTrue[First/@First[#],StringLength[#]>1&]&]
In[]:=
Out[]=
First/@%292
In[]:=
Out[]=
InteractiveListSelectorSW[Function[r,MultiwaySystem[r,#,3,"StatesGraph"]&/@DeleteCases[findCanonicalCriticalPairs[r],{x_,x_}]r]/@%306]
In[]:=
Out[]=
{"AB""BA","BAA""A"}{"AA","BAAA"}1
{{AAA,ABBAA},{AAA,ABBAA}}