The Cuckoo's Egg Reading Questions and Answers

MODERATOR NOTE: Wolfram notebook is attached at the terminate of the mail service.

In retention of John Horton Conway, 1937-2020

Conway at Princeton

John Horton Conway, described by Michael Atiyah every bit "the world's most magical mathematician", was one of the about bright and playful mathematicians of our fourth dimension. In his career, he studied a various assortment of subjects, from abstruse algebra, with Monstrous Moonshine, to geometry, with Conway Polyhedral Note, and most famously, mathematical computing and game theory, with his eponymous Game of Life. Perhaps one of his nearly curious (and certainly less well-known) contributions is what he chosen the Audioactive, (or Cuckoo's Egg) sequence.

The Audioactive Sequence

To explain the sequence, it is best to advise a riddle (which is how it is often proposed).

What comes next in the sequence: one, 11, 21, 1211, 111221, 312211 ... ?

If you have not seen this before, take a moment to think about this before reading farther.

The answer, of course, is 13112221 - the sequence is fabricated by reading aloud the previous term, like you would a telephone number - hence, audioactive. For example, 111221 would exist read every bit 'three ones, two twos and one i' - hence, 312211.

You may be wondering about where the Mathematica comes in. Take patience.

Firstly, the sequence in code:

In[1]: audioactive[list_] := Flatten[{Length[#], #[[1]]} & /@ Carve up[list]]

To test it out (in colour, which makes it a lot easier to see):

In[2]: styled[string_, colour_] :=   Manner[string, FontFamily -> "Courier New", FontSize -> 50,    FontColor -> color]; digits = <|1 -> styled["1", Red],    2 -> styled["2", Green], iii -> styled["iii", Blue]|>;  In[3]: SetDirectory[NotebookDirectory[]];      Export["sequence1.gif",   Row[digits[[#]] & /@ #] & /@ NestList[audioactive, {1}, ten],   "AnimationRepetitions" -> \[Infinity],   "DisplayDurations" -> Tabular array[.5, 11]];  (*I did try GraphicsRow, but this didn't seem to work -      if anyone tin explain, delight comment*)

which returns The Look-and-Say sequence, in full colour

One interesting observation to be fabricated is that there appear to exist no 4s here - the only digits are 1s, 2s and 3s. `Fifty-fifty if we did start with a 4, detect what happens to it:

In[four]: Export["sequence2.gif",   Row[Bring together[digits[[#]] & /@ #[[;; -ii]], {Style["4",         FontFamily -> "Courier New", FontSize -> 50,         FontColor -> Purple, FontWeight -> Bold]}]] & /@    NestList[audioactive, {4}, 10],   "AnimationRepetitions" -> \[Infinity],   "DisplayDurations" -> Table[.5, 11]];

Why are there no fours?

Whatsoever number larger than iv volition stay in the aforementioned relative position - for the most part, they are entirely irrelevant. In fact, unless the get-go sequence contains a 4 or college, or a string of 4 identical numbers, then the numbers 4 and college will never announced (which, in true mathematical manner, is left every bit an exercise to the reader) - that is, a iv can only occur later than the second iteration (or "day" as Conway calls it) if it has occurred in the kickoff two days. This is known as the Two Day Theorem (this wonderful biochemistry commodity, which was thankfully retrieved, talks about this, and the residue of the article in much greater depth, likewise as showing the connection betwixt this and RNA sequences - fascinating). From here on in, we will but consider sequences comprising of 1s, 2s and 3s.

Conway'due south Constant

One question which might exist asked is how the length of the sequence behaves, especially from an asymptotic perspective. Let u.s.a. brainstorm with a sequence beginning with "1":

In[5]: lengths1 = Length /@ NestList[audioactive, {i}, 25];  In[6]: ListLinePlot[lengths1]

which returns

First sequence of lengths

It is very clear that this is an exponential bend - so, information technology'southward natural to take a look at the ratios of the sequence lengths.

Let'southward expect at another starting sequence, and compare this on a logarithmic plot:

In[7]: lengths2 = Length /@ NestList[audioactive, {1, three, ii}, 25];  In[viii]: ListLogPlot[{lengths1, lengths2}, Joined -> Truthful]

giving

Huh, that's odd...

It looks similar both curves eventually take the same slope - that is, the ratio of the sequent lengths reaches the aforementioned value somewhen. So, it would be reasonable to conjecture that:

At that place exists some $\lambda$ such that, for almost all sequences, there exists some constant $C$ such that, subsequently n days, the length of the sequence is asymptotically equal to $C \cdot \lambda^n$

Here, "almost all" turns out to be all sequences of digits, with the exceptions of the empty sequence and the sequence 22 (which just repeats forever). The value of $\lambda$ (which is known equally Conway's constant) can exist estimated quite easily:

In[9]: N[lengths1[[-1]]/lengths1[[-2]]]  Out[9]: one.30288

But what is the exact value of Conway's constant?

Case - Fibonacci words

Define a sequence (which is significantly simpler to analyse compared to Conway'southward 1), to starting time with A (or any other sequence of As and Bs, for that matter), and substitute an A for a B, and a B for an AB.

In[ten]: fibonacciWord[list_] := Flatten[list /. {"A" -> "B", "B" -> {"A", "B"}}]  In[eleven]: letters = <|"A" -> styled["A", Carmine], "B" -> styled["B", Light-green]|>;  In[12]: Export["sequence3.gif",   Row[letters[[#]] & /@ #] & /@ NestList[fibonacciWord, {"A"}, viii],   "AnimationRepetitions" -> \[Infinity],   "DisplayDurations" -> Tabular array[.5, 9]];

giving Fibonacci words The astute amid y'all may detect that the lengths of the sequence are Fibonacci numbers. Notice that, if we have a vector consisting of the number of As and the number of Bs in the sequence, say, $\begin{pmatrix} \#A \\ \#B \end{pmatrix}$, then by the definition of our sequence, later one iteration, we will finish upwardly with $\begin{pmatrix} 0 & 1 \\ 1 & 1\end{pmatrix} \cdot \begin{pmatrix} \#A \\ \#B \end{pmatrix}$. If nosotros assume the ratios between the number of Every bit and number of Bs will eventually converge to some vector, $\begin{pmatrix} p_A \\ p_B \end{pmatrix}$, this will exist an eigenvector of the matrix - since it will get mapped into the same proportions. If the eventual ratio of lengths is some $\phi > ane$, then this will be mapped to $\begin{pmatrix} \phi \cdot p_A \\ \phi \cdot p_B \terminate{pmatrix}$ - so it is the eigenvalue of the vector (and therefore, a root of the characteristic polynomial of the matrix - sorry if this is getting a scrap linear algebra-y).

In[13]: matrix = {{0, 1}, {i, 1}};  In[xiv]: Eigenvalues[matrix]  Out[14]: {i/2 (1 + Sqrt[5]), 1/2 (i - Sqrt[5])}

The only positive value here is $\frac{1+\sqrt{5}}{2}$, better known equally the Golden Ratio (which is also the ratio between sequent terms of a general Fibonacci sequence). This is exactly what we are going to attempt here.

There is a problem, though: this isn't a unproblematic commutation system like the Fibonacci words. So how tin can we utilize this trick to notice the value of Conway'south abiding?

Conway'south Cosmological Theorem

In a stroke of genius, Conway had an thought - try to find long sequences, called elements, which volition somewhen decompose into other elements. The crux was to bear witness that every sequence volition eventually decay into i of these elements (which, in feature expert humor, were named after chemical elements, from Hydrogen to Plutonium). This atomic number 82 to the Cosmological Theorem:

Theorem: Later on 24 days, every sequence volition decay into a concatenation of mutual and transuranic (i.due east, Plutonium and Neptunium) elements.

(A proof of this can be found in this paper past Ekhad and Zeilberger - interestingly, it was proven using a estimator for the most part; the original proof by Conway has unfortunately been lost). This will not be proven here, nor will information technology exist fix every bit an do to the reader - it took hundreds of lines of code to prove (I guess information technology was Maple in 1998, though); it may be another Mathematica projection for a later date...

Computing Conway's Constant

The biochemistry article turns out to have pre-computed the sequences and "decays" of the elements, in Appendix 4; the raw text from this is in attachment. In keeping with the "ignore all values greater than 3" policy, I take removed both tranuranic elements - since these specifically deal with the such digits.

Firstly, bones text manipulation:

In[15]: rawElements = Clan[#[[2]] -> {#[[3]],        StringSplit[#[[4]], DigitCharacter] /. "" -> Null} & /@     Segmentation[     StringSplit[      Import["elements.txt"]], 4]];

All this does is converts the text file format from number, element, sequence, decays, into the more than useful element -> {sequence, decays}. Next, this kind of dataset is begging to be drawn as a graph - then this is what we shall do.

In[16]: labels = (# -> Tooltip[Framed[#], Entity["Element", #]]) & /@   Keys[rawElements];  In[17]: graph = Graph[Flatten[   Table[#[[1]] -> #[[2, k]], {k, Length[#[[2]]]}] & /@     List @@@ Normal@(#[[2]] & /@ rawElements)], VertexLabels -> labels,   VertexLabelStyle -> 15]

returning this:

I <i>love Vanadium!

with the handy mouse-over property. Observe that, for the most part, elements disuse by 1 each time - for example, Manganese decays to Chromium, which in turn decays to Vanadium (my favourite element). There are some exceptions to this - for instance, Hydrogen, which but decays into itself.

Another useful representation of graphs is the adjacency matrix, $(m_{u,5})_{u, v \in 5}$ - where chemical element $m_{u,five}$ counts the number of directed paths from u to five. (This is analagous to the matrix discussed in the Fibonacci Words department), which is best described equally an Array Plot:

In[18]: AdjacencyMatrix[graph] // ArrayPlot

giving: Not very fancy, but oh well. which gives a clearer indication as to how the elements tend to disuse. Let us plot the eigenvalues, highlighting those which are real and greater than one in crimson:

In[xix]: eigs = Eigenvalues[AdjacencyMatrix[graph]];  In[20]: ComplexListPlot[{eigs, Select[eigs, Positive[# - 1] &]},   Axes -> False, PlotMarkers -> {"\[Times]", fifteen},   PlotStyle -> {Black, Red}]

returning

Voila!

There is only one red cross.

This is Conway'due south constant.

In[21]: \[Lambda] = Select[eigs, Positive[# - ane] &][[1]];

To 100 decimal places:

In[22]: N[\[Lambda], 100]  Out[22]: i.30357726903429639125709911215255189073070250465940487575486139062855\ 0887852461557126815766864425226

Since this is the root of the characteristic polynomial, information technology is not transcendental; its minimal polynomial is:

In[23]: MinimalPolynomial[\[Lambda], t]  Out[23]: -half dozen + 3 t - 6 t^2 + 12 t^3 - 4 t^4 + vii t^5 - 7 t^half-dozen + t^7 + 5 t^9 -   2 t^10 - 4 t^eleven - 12 t^12 + 2 t^13 + 7 t^xiv + 12 t^15 - vii t^sixteen -   ten t^17 - 4 t^eighteen + 3 t^19 + 9 t^20 - vii t^21 - 8 t^23 + 14 t^24 -   3 t^25 + 9 t^26 + 2 t^27 - 3 t^28 - 10 t^29 - 2 t^thirty -   vi t^31 + t^32 + 10 t^33 - 3 t^34 + t^35 + seven t^36 - 7 t^37 + 7 t^38 -   12 t^39 - 5 t^40 + 8 t^41 + 6 t^42 + 10 t^43 - 8 t^44 - eight t^45 -   7 t^46 - 3 t^47 + 9 t^48 + t^49 + 6 t^50 + 6 t^51 - ii t^52 -   3 t^53 - 10 t^54 - two t^55 + iii t^56 + five t^57 +   two t^58 - t^59 - t^sixty - t^61 - t^62 - t^63 + t^64 + 2 t^65 +   2 t^66 - t^67 - 2 t^68 - t^69 + t^71

a 71st degree polynomial. Since the polynomial has leading coefficient 1, and $\lambda$ is not integer, by the Rational Root Theorem, information technology must be irrational.

Finally, what are the relative proportions of 1s, 2s and 3s? All we demand for this, as we saw earlier, is the eigenvector associated with this.

In[24]: vector = Start@NullSpace[   Due north[AdjacencyMatrix[graph] - \[Lambda]*IdentityMatrix[92]]];

Next, to count the number of characters in each element:

In[25]: count[char_] :=   Count[Characters[First[#]], char] & /@ Values[rawElements]  In[26]: proportions =   Normalize[{count["1"].vector, count["two"].vector, count["3"].vector},     Total]*100  Out[26]: {47.1995, 34.6579, 18.1426}

So, we should expect to see significantly more 1s and 2s than 3s - in fact, well-nigh half of all the digits can exist expected to exist a 1. In a pie chart, using the same colour scheme as before:

In[27]: PieChart[proportions, ChartLegends -> {"1", "2", "iii"},   ChartStyle -> {Ruby, Green, Bluish}, LabelingSize -> 100]

which gives:

Pie charts are great

If the sequence tended to infinity, and all we saw was a blur, the colour nosotros would see would be:

In[28]: RGBColor[proportions/100]

which returns a rather unpleasant shade of brown. Oh well.

In memoriam, John Horton Conway, 1937 - 2020

The Cuckoo's Egg Reading Questions and Answers

Source: https://community.wolfram.com/groups/-/m/t/1944369

11 Eve Colman