Juego del Caos : Cambiando el dado en el caso del cuadrado

Descargar como Notebook

Volviendo al Juego del Caos del cual ya lo había mencionado en las publicaciones del 24 de abril del 2018, mostrando la obtención del Triángulo de Sierpinski, y en la publicación del 28 de agosto de 2018, donde se extendía el procedimiento del Juego del Caos para dados de más de tres opciones. Observábamos que, excepto para cuatro, se obtenían figuras con cierto comportamiento de índole fractal, para cuatro obteníamos la primera figura, sin ninguna estructura particular.

Como se explicó en la publicación del 28 de agosto de 2018, cambiando el dado para cuatro siguiendo la secuencia de un gen del genoma humano se obtenía una figura que claramente tenía un comportamiento fractal, segunda y tercera que difieren del orden de las letras en los vértices.

Voy a seguir cambiando el dado buscando algún tipo de comportamiento en la gráfica al tomar un dado con cuatro opciones, pero con un comportamiento no necesariamente regido por el azar.

  Primero, defino la función cuadrado[ ] que dada una lista (dado) de secuencias de los dígitos
{1, 2, 3, 4} la gráfica según las reglas del Juego del Caos.

cuadrado[lista_List] := Module[{long = Length[lista],
   dado = Table[lista[[n]], {n, Length[lista]}],
   vertices = {{0, 0}, {0, 1}, {1, 0}, {1, 1}}},
  siguiente[punto_] := Module[{num}, num = First[dado];
    dado = Rest[dado]; (vertices[[num]] + punto)/2.];
  
  ListPlot[NestList[siguiente, {0, 0}, Length[lista] - 1], 
   PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}}, AspectRatio -> 1, 
   Axes -> False, PlotStyle -> PointSize[0.001]]]

Diferentes Dados

Generamos listas con los dígitos {1,2,3,4} siguiendo diferentes criterios para su obtención.

Primos módulo 5

A la lista de los números primos mayores que 5 les calculamos su módulo con respecto a 5, residuo que se obtiene al dividir el número por 5.

lista1 = Table[Mod[Prime[n], 5], {n, 4, 200000}];
Tally[%]

{{2, 50071}, {1, 49964}, {3, 50020}, {4, 49942}}

Vemos que el dado no está "cargado" hacia algún resultado,

cuadrado[lista1]

la figura obtenida muestra una estructura fractal.

Distancia entre primos

Ahora, como dado tomaré la distancia entre primos consecutivos dividida por 2 y tomando módulo 4.

lista2 = Table[
   Mod[(Prime[n + 1] - Prime[n])/2, 4] + 1, {n, 2, 200000}];
Tally[%]

{{2, 57160}, {3, 53349}, {4, 56687}, {1, 32803}}

cuadrado[lista2]

Se obtiene una estructura fractal similar a la que se obtuvo con el genoma.

Números Normales

En la publicación del 4 de julio del 2017 expresaba sobre los Números Normales que:

Un número real es un Número Normal en base b si en su expansión decimal en base b los dígitos se distribuyen de una forma uniforme. Es decir, los números de una cifra aparecen en la misma proporción, los de dos cifras, los de tres cifras, etc.

Tomaré las cifras decimales de algunos números que hasta el momento se conjetura que son normales: Pi, Euler y la constante Aurea, para que el dado no esté cargado eliminaré los 8 y 9 y ahí sí tomaré módulo 4.

lista3 = Mod[
    Select[RealDigits[N[GoldenRatio, 100000]][[1]], 
     And[# != 8, # != 9] &], 4] + 1;
Tally[%]

{{2, 19980}, {3, 19924}, {1, 20027}, {4, 20067}}

cuadrado[lista3]

En todos se obtiene un gráfico sin ninguna estructura del tipo la primera que se mostraba cuando el dado era totalmente al azar. Lo que también ocurre al tomar Módulo 5 y eliminar alguno de los dígitos, para que el dado tenga cuatro resultados.

lista4 = Select[Mod[RealDigits[N[Pi, 100000]][[1]], 5], # != 0 &];
Tally[%]

{{3, 20004}, {1, 20165}, {4, 19873}, {2, 19933}}

cuadrado[lista4]


Números no normales

Número de Champernowne

Tomando como dado las cifras del número de Champernowne generado concatenando los números enteros positivos como sus cifras decimales, Mathematica lo genera con el comando ChampernowneNumber[10].

lista5 = Mod[
    Select[RealDigits[N[ChampernowneNumber[10], 1000000]][[1]], 
     And[# != 8, # != 9] &], 4] + 1;
Tally[%]

{{2, 273533}, {3, 188077}, {4, 188077}, {1, 178067}}

cuadrado[lista5]

Aunque no veo una estructura fractal, si tiene un comportamiento en su ordenamiento.

Número de Copeland - Erdös

Es el número decimal entre cero y uno cuyas cifras decimales se obtienen concatenando los números primos. El cual lo podemos construir en Mathematica, en sus primeras cifras, como:

cop = Flatten[Prepend[IntegerDigits[Table[Prime[n], {n, 20}]], 0]];
N[FromDigits[{cop, 1}], Length[cop] - 1]

0.235711131719232931374143475359616771

Así, determinamos la lista de los números primos y determinamos sus dígitos, eliminamos 8 y 9 y tomamos módulo 4.

lista6 = Mod[
    Select[Flatten@IntegerDigits[Table[Prime[n], {n, 100000}]], 
     And[# != 8, # != 9] &], 4] + 1;
Tally[%]

{{3, 102482}, {4, 145036}, {2, 149895}, {1, 93835}}

cuadrado[lista6]

Ahora, sin eliminar 8 y 9.


lista7 = Mod[Flatten@IntegerDigits[Table[Prime[n], {n, 100000}]], 
    4] + 1;
Tally[%]

{{3, 102482}, {4, 145036}, {2, 221957}, {1, 141009}}

cuadrado[lista7]

Ejercicio

1. Determinar otros tipos de dados, con cuatro resultados, que generen algún tipo de estructura.
2. ¿Qué pasa al tomar dados con 3,5,6,7,... número de resultados posibles para generar polígonos regulares de 3,5,6,7,... lados respectivamente.?


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