Kolakoski Sequence

Author

Eric W. Weisstein
April 21, 2006

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

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

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

Code

KolakoskiSeqeuence1[k_]:=Prepend[Nest[Flatten[Partition[#,2]/.{{2,2}->{2,2,1,1},{2,1}->{2,2,1},{1,2}->{2,1,1},{1,1}->{2,1}}]&,{2,2},k],1]

KolakoskiSeqeuence[n_]:=Module[{a={1,2,2},k,i},
Do[AppendTo[a,1+Mod[k-1,2]],{k,3,n},{i,a[[k]]}];
a
]

KolakoskiK[1]:=1;
KolakoskiK[n_]:=NestWhile[Flatten[Partition[#,2]/.{{2,2}->{2,2,1,1},{2,1}->{2,2,1},{1,2}->{2,1,1},{1,1}->{2,1}}]&,{2,2},Length[#]<n-1&][[n-1]]

Enumeration

A006928

A000002

(l=KolakoskiSequence[10^8]);//Timing

Kolakoski[8]

Kolakoski1[8]

Kolakoski2[8]

KolakoskiK/@Range[20]

Plot

k=Kolakoski2[10^4];//Timing

ListPlot[Rest[FoldList[Plus,0,2-k]]/Range[Length[k]],PlotJoined->True,PlotStyle->Red,AxesLabel->TraditionalForm/@{n,(Subscript[N, 1])[n]/n}]

Recurrence Plot

g=ArrayPlot[Table[Mod[k[[x]]-k[[y]],2],{x,128},{y,128}],PixelConstrained->True]

<<Utilities`GIF`;

Export[gifs<>"Kolakoski.gif",g]

Kolakoski Constant

Kolakoski[3]

Kolakoski[5]-1

Total[MapIndexed[#1 2^(-#2[[1]])&,{1,1,0,0,1,0,1,1,0}]]//N

N[FromDigits[{Kolakoski[20]-1,1},2],20]