Table[InteractiveListSelectorSW[First/@GatherBy[SubstitutionSystemCausalGraph[#,"AA",6]#&/@sigsA[n],First]],{n,1,6}]
In[]:=
Out[]=
{{AAAAA},{AAAAA}}
SubstitutionSystemCausalGraph["AA""AAA","AA",14]
In[]:=
Out[]=
GraphPlot[%]
In[]:=
Out[]=
SMWXGraphicsStreamed[SMWEvolveListX[{"AA"->"AAA"},"AA",7],CellLabelsTrue]
In[]:=
Out[]=
SMWEvolveListX[{"AA"->"AAA"},"AA",7]
In[]:=
Out[]=
StringLength/@NestList[StringReplace[#,{"AA"->"AAA"}]&,"AA",20]
In[]:=
{2,3,4,6,9,13,19,28,42,63,94,141,211,316,474,711,1066,1599,2398,3597,5395}
Out[]=
StringLength/@NestList[StringReplace[#,{"AA"->"AAA"}]&,"AA",25]
In[]:=
{2,3,4,6,9,13,19,28,42,63,94,141,211,316,474,711,1066,1599,2398,3597,5395,8092,12138,18207,27310,40965}
Out[]=
Ratios[%488]//N
In[]:=
{1.5,1.33333,1.5,1.5,1.44444,1.46154,1.47368,1.5,1.5,1.49206,1.5,1.49645,1.49763,1.5,1.5,1.4993,1.5,1.49969,1.5,1.49986,1.49991,1.5,1.5,1.49997,1.5}
Out[]=
{2,3,4,6,9,13,19,28,42,63,94,141,211,316,474,711,1066,1599,2398,3597,5395,8092,12138,18207,27310,40965}
NestList[If[EvenQ[#],3#/2,(3#-1)/2]&,2,10]
In[]:=
{2,3,4,6,9,13,19,28,42,63,94}
Out[]=
NestList[(3/2If[EvenQ[#],#,#-1])&,2,10]
In[]:=
{2,3,3,3,3,3,3,3,3,3,3}
Out[]=
FindSequenceFunction[%,t]
In[]:=
DifferenceRootFunction{y.,n.},1+y.[n.]-y.[3+n.]-y.[5+n.]-y.[6+n.]-y.[7+n.]+y.[9+n.]0,y.[1]2,y.[2]3,y.[3]4,y.[4]6,y.[5]9,y.[6]13,y.[7]19,y.[8]28,y.[9]42[t]
Out[]=
FindLinearRecurrence[%%]
In[]:=
{1,1,0,0,-1,1,-1,0,-1,1}
Out[]=
FindLinearRecurrence[%]
In[]:=
FindLinearRecurrence[{2,3,4,6,9,13,19,28,42,63,94,141,211,316,474,711,1066,1599,2398,3597,5395,8092,12138,18207,27310,40965}]
Out[]=
Table[InteractiveListSelectorSW[First/@GatherBy[SubstitutionSystemCausalGraph[#,"AAA",5]#&/@sigsA[n],First]],{n,1,6}]
In[]:=
Out[]=
{{AA,AAAA}}
SubstitutionSystemCausalGraph[{"A""A","AA""AA"},"AAA",10]
In[]:=
Out[]=
Table[InteractiveListSelectorSW[First/@GatherBy[SubstitutionSystemCausalGraph[#,"AAAA",4]#&/@sigsA[n],First]],{n,1,6}]
In[]:=
Out[]=
{}
{{AAAAA},{AAAAA}}
Table[InteractiveListSelectorSW[First/@GatherBy[SubstitutionSystemCausalGraph[#,"AAAAA",4]#&/@sigsA[n],First]],{n,1,6}]
In[]:=
Out[]=
Table[InteractiveListSelectorSW[First/@GatherBy[SubstitutionSystemCausalGraph[#,"ABA",5]#&/@sigsA[n],First]],{n,1,6}]
In[]:=
Out[]=
Table[TotalCausalInvariantQ[#,1]&/@sigsA[n],{n,5}]
In[]:=
{{},{True},{True,True},{True,True,True,True},{True,True,True,True,True,True}}
Out[]=
SubstitutionSystemCausalGraph[#,"A",4]&/@{{"A""AAA"},{"A""AA","AAA""A"},{"A""AA","AA""AA"},{"A""AAA","AA""AA"},{"A""AA","AA""AAA"},{"A""AA","AAAAA""A"},{"A""AA","AA""AAAA"},{"A""AAAA","AA""AA"},{"A""AAA","AA""AAA"},{"A""A","A""AA","AA""AA"},{"A""A","A""AAA","AA""A"},{"A""AAA","AAAAA""A"},{"A""AAAAA","AAA""A"},{"A""AA","AA""AAAAA"},{"A""AAAAA","AA""AA"},{"A""AA","A""AA","AAA""A"},{"A""A","A""AA","AA""AAA"},{"A""AAAA","AA""AAA"}}
In[]:=
Out[]=
Catenate[Table[sigsA[n],{n,6}]]
In[]:=
Out[]=
Select[%507,AnyTrue[First/@#,StringLength[#]≤2&]&]
In[]:=
Out[]=
bigcg[rule_,init_,maxt_,maxv_]:=Catch[(Do[With[{w=SubstitutionSystemCausalGraph[rule,init,t]},If[VertexCount[w]>maxv,Throw[w],w]],{t,maxt}];SubstitutionSystemCausalGraph[rule,init,maxt])]
In[]:=
Labeled[UndirectedGraph[bigcg[#,"AA",10,200],GraphLayout"SpringElectricalEmbedding",ImageSize130],#]&/@{{"A""A"},{"A""AA"},{"AA""A"},{"A""AAA"},{"AA""AA"},{"A""A","A""A"},{"A""AAAA"},{"AA""AAA"},{"A""A","A""AA"},{"A""A","AA""A"},{"A""AAAAA"},{"AA""AAAA"},{"A""A","A""AAA"},{"A""A","AAA""A"},{"A""A","AA""AA"},{"A""AA","A""AA"},{"A""AA","AA""A"},{"AA""A","AA""A"},{"A""A","A""A","A""A"}}
In[]:=
Out[]=
SubstitutionSystemCausalGraph["AAA""AAAA","AAA",20]
In[]:=
Out[]=
bigcg[StringRepeat["A",#1]StringRepeat["A",#2],StringRepeat["A",#1],50,200]&@@@{{2,3},{2,5},{2,7},{2,9},{3,4},{3,5},{3,7},{3,8}}
In[]:=
Out[]=
Labeled[bigcg[StringRepeat["A",#1]StringRepeat["A",#2],StringRepeat["A",#1],50,200],{#1,#2}]&@@@{{2,3},{2,5},{2,7},{2,9},{3,4},{3,5},{3,7},{3,8},{3,10},{4,5},{4,7},{4,9},{5,6},{5,7},{5,8},{5,9},{6,7}}
In[]:=
Out[]=
Flatten[Table[If[i≥j,Nothing,i/j],{i,10},{j,10}]]
In[]:=

1
2
,
1
3
,
1
4
,
1
5
,
1
6
,
1
7
,
1
8
,
1
9
,
1
10
,
2
3
,
1
2
,
2
5
,
1
3
,
2
7
,
1
4
,
2
9
,
1
5
,
3
4
,
3
5
,
1
2
,
3
7
,
3
8
,
1
3
,
3
10
,
4
5
,
2
3
,
4
7
,
1
2
,
4
9
,
2
5
,
5
6
,
5
7
,
5
8
,
5
9
,
1
2
,
6
7
,
3
4
,
2
3
,
3
5
,
7
8
,
7
9
,
7
10
,
8
9
,
4
5
,
9
10

Out[]=
Select[%,Numerator[#]≠1&]
In[]:=

2
3
,
2
5
,
2
7
,
2
9
,
3
4
,
3
5
,
3
7
,
3
8
,
3
10
,
4
5
,
2
3
,
4
7
,
4
9
,
2
5
,
5
6
,
5
7
,
5
8
,
5
9
,
6
7
,
3
4
,
2
3
,
3
5
,
7
8
,
7
9
,
7
10
,
8
9
,
4
5
,
9
10

Out[]=
NumeratorDenominator/@%
In[]:=
Out[]=
DeleteDuplicates[{{2,3},{2,5},{2,7},{2,9},{3,4},{3,5},{3,7},{3,8},{3,10},{4,5},{2,3},{4,7},{4,9},{2,5},{5,6},{5,7},{5,8},{5,9},{6,7},{3,4},{2,3},{3,5},{7,8},{7,9},{7,10},{8,9},{4,5},{9,10}}]
In[]:=
Out[]=