Wolfram Sequences

Author

Eric W. Weisstein
March 12, 2009

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/WolframSequences.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/WolframSequences.html.

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

Initialization

BinaryPlot[l_,opts___]:=Module[{pad=1+Floor[Log[2,Max[l]]]},
If[pad==1,pad=2];
ListDensityPlot[Reverse[IntegerDigits[#,2,pad]&/@l],
opts,
AspectRatio->Automatic,ColorFunction->(GrayLevel[1.-#]&),
Frame->False]
]

3/2-Sequence

Figure

V5

With[{n=40},
l=NestList[3/2If[EvenQ[#],#,1+#]&,1,n];
ListDensityPlot[Reverse[IntegerDigits[#,2,1+Floor[Log[2,l[[-1]]]]]&/@l],
AspectRatio->Automatic,ColorFunction->(GrayLevel[1.-#]&),
Frame->False]
]

V6

With[{n=40},
l=NestList[3/2If[EvenQ[#],#,1+#]&,1,n];
ArrayPlot[Reverse[IntegerDigits[#,2,1+Floor[Log[2,l[[-1]]]]]&/@l],Mesh->True,DataReversed->True]
]

5/2-Sequences

ListDensityPlot[Join@@@Transpose[Table[Reverse@IntegerDigits[#,2,3+Floor[Log[2,Max[#]]]]&@NestList[1/2If[EvenQ[#],5#,1+#]&,n,100],{n,10}]],
AspectRatio->Automatic,ColorFunction->(GrayLevel[1.-#]&),
Frame->False,Mesh->False
]

Show[GraphicsArray[Table[
BinaryPlot[NestList[1/2If[EvenQ[#],5#,1+#]&,n,20],DisplayFunction->Identity],{n,10}]],ImageSize->20]

Misc. Sequences

<<Utilities`EISFormat`

Sequence

FormatSequence[NestList[3/2If[EvenQ[#],#,1+#]&,1,60],
070318,1,
Name->"a(n) = 3/2a(n-1) if a(n-1) is even; 3/2(a(n-1)+1) is a(n-1) is odd.",
html["Wolfram Seaquences"],
Detail->{"Wolfram, S.  A New Kind of Science.  Champaign, IL: Wolfram Media, p. 123, 2002."},
Date->"May 14, 2002"
]

(b): f(n)=2+f(n-f(n-1))

Clear[f];

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

FormatSequence[Table[f[n],{n,100}],
070864,1,
Name->"Recursive sequence (b).",
Detail->{"Wolfram, S.  A New Kind of Science.  Champaign, IL: Wolfram Media, p. 129, 2002."},
Date->"May 14, 2002",
html["Wolfram Seaquences"]
]

(f): f(n-f(n-1)-1)+f(n-f(n-2)-1)

Clear[f];

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

FormatSequence[Table[f[n],{n,100}],
070867,1,
Name->"Recursive sequence (f).",
html["Wolfram Seaquences"],
Detail->{"Wolfram, S.  A New Kind of Science.  Champaign, IL: Wolfram Media, p. 129, 2002."},
Date->"May 14, 2002"
]

(h): f(f(n-1))+f(n-2f(n-1)+1)

Clear[f];

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

FormatSequence[Table[f[n],{n,100}],
070868,1,
Name->"Recursive sequence (h).",
html["Wolfram Seaquences"],
Detail->{"Wolfram, S.  A New Kind of Science.  Champaign, IL: Wolfram Media, p. 129, 2002."},
Date->"May 14, 2002"
]