Sucesión de Kolakoski

Descargar como Notebook

Se debe al artista norteamericano William Kolakoski (1944-1997) quien tenía como pasatiempo la matemática recreativa, la publicó en la revista American Mathematical Monthly en 1965, aunque ya en 1939 el matemático Rufus Oldenburger había hecho mención de ella.

La Sucesión de Kolakoski tiene como primeros términos:

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 . . .

Para entender como se construye primero debemos hablar de la sucesión contadora de otra sucesión dada (sobre la cual publiqué el 20 de Noviembre de 2018 aquí), que es la sucesión formada por los enteros positivos que indican el número de bloques de símbolos consecutivos iguales en la sucesión. Por ejemplo, la sucesión contadora de la sucesión:

a b b a a b b b a b a a b b . . .

es la sucesión:

1 2 2 3 1 1 2 2 . . .

pues empieza con 1 letra a, luego 2 letras b, 2 letras a, 3 letras b y así sucesivamente.

Ahora sí, la principal característica de la Sucesión de Kolakoski es que ella es su propia sucesión contadora.

En Mathematica

ko = {1, 2, 2};
Do[Which[ko[[n]] == 1 && Last[ko] == 1, AppendTo[ko, 2], 
  ko[[n]] == 1 && Last[ko] == 2, AppendTo[ko, 1], 
  ko[[n]] == 2 && Last[ko] == 1, AppendTo[ko, {2, 2}]; 
  ko = Flatten[ko], ko[[n]] == 2 && Last[ko] == 2, 
  AppendTo[ko, {1, 1}]; ko = Flatten[ko]], {n, 3, 20}]
ko

{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}

Función contadora

La podemos calcular por medio de:

contadora[list_List] := Module[{j = 1,
   con = {}, len = Length[list]}, lis = Map[ToString, list];
  Do[Which[n == len - 1 && lis[[n]] == lis[[n + 1]], j++; 
    AppendTo[con, j], n == len - 1 && lis[[n]] != lis[[n + 1]], 
    AppendTo[con, {j, 1}], lis[[n]] == lis[[n + 1]], j++, 
    lis[[n]] != lis[[n + 1]], AppendTo[con, j]; j = 1], {n, len - 1}];
   Flatten[con]]

La función contadora[ ] aplicada a la salida de la Sucesión de Kolakoski nos da una sub lista de la Sucesión de Kolakoski compuesta por 20 términos, el número que habíamos puesto para calcularla.

contadora[ko]
{1, 2, 2, 1, 1, 2, 1, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 2, 2, 1}

Length[%]
20

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas