Look and Say Sequence

Author

Eric W. Weisstein
April 17, 2005

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

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

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

Code

RunLengthEncode[x_List]:=Through[{First,Length}[#]]&/@Split[x]
LookAndSay[n_,d_:1]:=NestList[Flatten[Reverse/@RunLengthEncode[#]]&,{d},n-1]

Examples

LookAndSay[5]

FromDigits/@LookAndSay[10]

Map[FromDigits,LookAndSay[10,#]&/@Range[9],{2}]//ColumnForm

Number of Digits

Timing[digits=Length/@LookAndSay[60]]

Show[Block[{$DisplayFunction=Identity},
ListPlot[Log[Length/@LookAndSay[60,#]],PlotStyle->{Red,Blue}[[#]],PlotJoined->True,AxesLabel->TraditionalForm/@{n,d[n]}]&/@Range[2]
]]//Timing

Conway's Constant

FindFit[digits,c λ^n,{c,λ},n,WorkingPrecision->20]

FindFit[Length/@LookAndSay[50,1],c λ^n,{c,λ},n,WorkingPrecision->20]//Timing

FindFit[Length/@LookAndSay[50,2],c λ^n,{c,λ},n,WorkingPrecision->20]//Timing

FindFit[Length/@LookAndSay[50,3],c λ^n,{c,λ},n,WorkingPrecision->20]//Timing

Polynomial[l_List,x_]:=Fold[x #1+#2&,0,l]
(poly=Polynomial[{1,0,-1,-2,-1,2,2,1,-1,-1,-1,-1,-1,2,5,3,-2,-10,-3,-2,6,6,1,9,-3,-7,-8,-8,10,6,8,-5,-12,7,-7,7,1,-3,10,1,-6,-2,-10,-3,2,9,-3,14,-8,0,-7,9,3,-4,-10,-7,12,7,2,-12,-4,-2,5,0,1,-7,7,-4,12,-6,3,-6},x]//Expand)//TraditionalForm

roots=List@@(Last/@Roots[poly==0,x]);
λ=Select[roots,Positive][[1]]

neg=Select[roots,Negative]

N[%,20]

N[λ,50]

ListPlot[Through[{Re,Im}[#]]&/@N[roots],PlotStyle->{PointSize[.02],Blue},AspectRatio->Automatic,Epilog->{PointSize[.03],Red,Point[{λ,0}]}]

ContinuedFraction[λ,20]