# The Kolakoski Sequence

GROUPS:
 Ed Pegg 6 Votes The Kolakoski Sequence was recently in the news. It starts out as 12211212212211211221211212211211212212211212212112112212211212212211211212212112212211212212211211221211212212211211212 n = 10; ko = 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}, n], 1]; Try doing Length /@ Split[ko] on that, and you get the same sequence. It is self-descriptive. I bumped the code up to n=32 to get 1058436 terms. What is the behavior of 1 and 2 over that range?  ListPlot[FoldList[Plus, 0, 2 (ko - 3/2)], Joined -> True, AspectRatio -> 1/7] Seems pretty chaotic.
 Sander Huisman 5 Votes Thanks for sharing! So what about the 1-to-2 ratio? The long running average looks like: lra = Accumulate[N[ko]]/Range[Length[ko]]; ListPlot[lra[[;; ;; 10000]], DataRange -> {0, Length[ko]},Joined -> True] This result is for n=40. Pretty close to 1.5 indeedâ€¦
 Todd Rowland 4 Votes Thanks for sharing this sequence. I wonder if this isn't obvious somehow, but the blocks of size larger than 1 are not equally distributed. For size 2, it is about twice as likely to not have a repeat, n = 15; ko = 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}, n], 1]; Tally[Subsequences[ko, {2}]] (*{{{1, 2}, 359}, {{2, 2}, 178}, {{2, 1}, 359}, {{1, 1}, 182}}*) and for size three, the counts are almost the same but some cases are completely missing. Complement[Tuples[{1, 2}, 3], Subsequences[ko, {3}]] (*{{1, 1, 1}, {2, 2, 2}}*) The other thing I am thinking about is what is a good way to code the other definition, starting from self-describing via Split, maybe something involving Table like Nest[Flatten[Mod[MapIndexed[Table[#2[[1]], #] &, #], 2, 1]] &, {2, 2}, 10] which seems to have some problem I can't identify.
 Henrik Schachner 1 Vote Thanks for pointing out this excinting sequence! I could not resist playing around!Using Mathematica I am always amazed how much one can do with how little code: Using the code above kolakoskiSeq[iter_Integer] := 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}, iter], 1] then with kHead[l_] := Length[#] @@ # & /@ SplitBy[l, Head] koH = Length[#] @@ # & /@ Split[kolakoskiSeq[9]]; koTree = Nest[kHead, koH, 14]; Manipulate[TreeForm["Kolakoski" @@ Level[koTree, {level}], ImageSize -> 900, PlotStyle -> Blue], {level, 16, 3, -1}] one gets:@Todd Rowland: I like very much your approach of coding it differently! This seems to work: kolakoskiStep[seq_List] := Flatten@MapIndexed[ConstantArray[Mod[First[#2] + First[seq], 2] + 1, #1] &, seq] kSeq = Nest[kolakoskiStep, {1, 2}, 9] With this it becomes obvious that there are only two possible sequences of this type, one starting with the "seed" {1,2}, the other one with {2}.