Message Boards Message Boards

Self-generating Oldenburger-Kolakoski sequence

Ed Pegg, Wolfram Research
Posted 7 years ago

The Kolakoski Sequence was recently in the news. It starts out as

1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 2 1 2 1 1 2 1 2 2 1 1 2 1 1 2 1 2 2 1 2 2 1 1 2 1 2 2 1 2 1 1 2 1 1 2 2 1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 1 2 2 1 2 1 1 2 2 1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 2 1 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 1 2 . . .

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]

Kolakowski sequence

Seems pretty chaotic.
POSTED BY: Ed Pegg
5 Replies
Sort By:

A simple introduction to the sequence in Numberphile YouTube video:
POSTED BY: Vitaliy Kaurov

enter image description here -- you have earned Featured Contributor Badge enter image description here

Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!
POSTED BY: EDITORIAL BOARD

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:

enter image description here

@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}.
POSTED BY: Henrik Schachner

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.
POSTED BY: Todd Rowland

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]

enter image description here

This result is for n=40. Pretty close to 1.5 indeedÂ…
POSTED BY: Sander Huisman
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract