You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
In[]:=
MultiwayGrowthList[rule_,init_List,t_]:=Last/@NestList[Function[s,{Join[First[s],#],#}&[Complement[Union[Flatten[StringReplaceList[Last[s],rule]]],First[s]]]],{{},init},t]
In[]:=
MultiwayGrowthList[{"A""AB","B""AAA"},{"A"},4]
Out[]=
{{A},{AB},{AAAA,ABB},{AAAAB,AAABA,AABAA,ABAAA,ABBB},{AAAAAAA,AAAABB,AAABAB,AAABBA,AABAAB,AABABA,AABBAA,ABAAAB,ABAABA,ABABAA,ABBAAA,ABBBB}}
In[]:=
allsigs
Out[]=
Initial condition “A”
Initial condition “A”
In[]:=
ParallelMapMonitored[#->TimeConstrained[MultiwayGrowthList[#,{"A"},10],3]&/@EnumerateSubstitutionSystemRules[#,2]&,allsigs]
Out[]=
In[]:=
alllens=Map[First[#]Length/@Last[#]&,%,{2}];
In[]:=
First[alllens]
Out[]=
{{AA}{1,1,0,0,0,0,0,0,0,0,0},{AB}{1,1,0,0,0,0,0,0,0,0,0}}
In[]:=
Counts[Last/@Flatten[alllens]]
Out[]=
In[]:=
{First[#],FindLinearRecurrence[Last[First[#]]],Length[#]}&/@GatherBy[Select[Flatten[alllens],Head[FindLinearRecurrence[Last[#]]]===List&],Last]
Out[]=
In[]:=
Length/@MultiwayGrowthList[{"A""AB","B""AAB"},{"A"},12]
Out[]=
{1,1,2,5,13,34,89,233,610,1597,4181,10946,28657}
In[]:=
FindSequenceFunction[%,n]
Out[]=
(5+2-+4-++
5
)9n
3
2
5
2
5
n
3
2
5
2
n
3
2
5
2
5(9+4
5
)In[]:=
FullSimplify[%]
Out[]=
1
5
-n
2
5
)n
(3+
5
)n
(3-
5
)5
)In[]:=
FindLinearRecurrence[%181]
Out[]=
{3,-1}
In[]:=
LinearRecurrence[{3,-1},{1,1},n]
Out[]=
LinearRecurrence[{3,-1},{1,1},n]
In[]:=
If[Head[#]===Plus&&Length[#]>5,None,#]&@Expand[InterpolatingPolynomial[Range[10]^2,n]]
Out[]=
2
n
In[]:=
{First[#],If[Head[#]===Plus&&Length[#]>5,None,#]&@Expand[InterpolatingPolynomial[Last[First[#]],n]],Length[#]}&/@GatherBy[Select[Flatten[alllens],Head[FindLinearRecurrence[Last[#]]]=!=List&],Last]
Out[]=
ABA init
ABA init