Hofstadter-Conway 10,000-Dollar Sequence

Author

Eric W. Weisstein
April 22, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/Hofstadter-Conway10000-DollarSequence.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Hofstadter-Conway10000-DollarSequence.html.

©2024 Wolfram Research, Inc. except for portions noted otherwise

Sequence

Clear[a]

RSolve[{a[n]==a[a[n-1]]+a[n-a[n-1]],a[1]==a[2]==1},a[n],n]

a[1]:=1
a[2]:=1
a[n_]:=a[n]=a[a[n-1]]+a[n-a[n-1]]

Table[a[n],{n,20}]

Plot

a[1]:=1
a[2]:=1
a[n_]:=a[n]=a[a[n-1]]+a[n-a[n-1]]

With[{style=Directive[Black,FontFamily->"Times"]},
GraphicsRow[{
ListPlot[Table[a[n]/n,{n,2048}],Joined->True,
PlotStyle->Red,BaseStyle->style,LabelStyle->Directive[Black,14],
AxesLabel->{n,Row[{HoldForm[a[n]],"/",n}]}],
ListPlot[Table[a[n]-n/2,{n,2048}],Joined->True,
PlotStyle->Red,BaseStyle->style,LabelStyle->Directive[Black,14],
AxesLabel->{n,HoldForm[a[n]]-Row[{HoldForm[a[n]],"/",2}]}]
},Alignment->Center,ImageSize->Large]]

Related Sequence

b[1]:=1
b[2]:=1
b[n_]:=b[n]=b[b[n-1]]+b[n -b[n-2]-1]

Table[b[n],{n,20}]

With[{style=Directive[Black,FontFamily->"Times"]},
GraphicsRow[{
ListPlot[Table[b[n],{n,1024}],Joined->True,
PlotStyle->Red,BaseStyle->style,LabelStyle->Directive[Black,14],
AxesLabel->{n,Row[{HoldForm[b[n]]}]}],
ListPlot[Table[b[n]/n,{n,1024}],Joined->True,
PlotStyle->Red,BaseStyle->style,LabelStyle->Directive[Black,14],
AxesLabel->{n,Row[{HoldForm[b[n]],"/",n}]}]
},Alignment->Center,ImageSize->Large]]