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[]:=
MWEvolutionDistinct[f_,init_,t_]:=NestList[Catenate[f/@#]&,init,t]
In[]:=
MWEvolution[f_,init_,t_]:=NestList[Union[Catenate[f/@#]]&,init,t]
In[]:=
Clear[MWCoordGraph]
In[]:=
MWCoordGraph[f_,init_?NumericQ,t_,rat_:1,opts:OptionsPattern[]]:=With[{g=NestGraph[f,init,t]},Graph[g,VertexCoordinates(#{rat#,-GraphDistance[g,init,#]}&/@VertexList[g]),opts]]
In[]:=
MWCoordGraph[n{n+1,n+2},0,4,.5,VertexLabelsAutomatic]
Out[]=
In[]:=
MWCoordGraph[n{n+2,n+3},0,4,VertexLabelsAutomatic]
Out[]=
In[]:=
FoldList[Union[Join[#1,#2]]&,MWEvolution[n{n+1,n+2},{0},5]]
Out[]=
{{0},{0,1,2},{0,1,2,3,4},{0,1,2,3,4,5,6},{0,1,2,3,4,5,6,7,8},{0,1,2,3,4,5,6,7,8,9,10}}
In[]:=
Length/@%
Out[]=
{1,3,5,7,9,11}
In[]:=
FoldList[Union[Join[#1,#2]]&,MWEvolution[n{n+3,n+2},{0},5]]
Out[]=
{{0},{0,2,3},{0,2,3,4,5,6},{0,2,3,4,5,6,7,8,9},{0,2,3,4,5,6,7,8,9,10,11,12},{0,2,3,4,5,6,7,8,9,10,11,12,13,14,15}}
Out[]=
4+3t
In[]:=
Length/@FoldList[Union[Join[#1,#2]]&,MWEvolution[n{n+1,n+2},{0},8]]
Out[]=
{1,3,5,7,9,11,13,15,17}
In[]:=
FindSequenceFunction[Rest[%],t]
Out[]=
1+2t
In[]:=
Length/@FoldList[Union[Join[#1,#2]]&,MWEvolution[n{n+2,n+3},{0},8]]
Out[]=
{1,3,6,9,12,15,18,21,24}
In[]:=
FindSequenceFunction[Rest[%],t]
Out[]=
3t
In[]:=
Length/@FoldList[Union[Join[#1,#2]]&,MWEvolution[n{n+2,n+3,n+1},{0},8]]
Out[]=
{1,4,7,10,13,16,19,22,25}
In[]:=
FindSequenceFunction[Rest[%],t]
Out[]=
1+3t
In[]:=
NestGraph[n{n+1,n+2,n+3,n+4},0,6]
Out[]=
In[]:=
Graph3D[NestGraph[n{n+7,n+11},0,15]]
Out[]=
In[]:=
NestGraph[n{n+7,n+11},0,30]
Out[]=
In[]:=
Graph3D[%]
Out[]=
In[]:=
Graph3D[NestGraph[n{n+13,n+31},0,20]]
Out[]=
Fibonacci etc.
Fibonacci etc.
Rationals
Rationals