Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

viernes, 9 de diciembre de 2016

Conjetura de Collatz como un Fractal



La Conjetura de Collatz de la cual hablamos en la entrada del 20 de noviembre de 2016, es uno de esos problemas abiertos que fascinan por su gran sencillez y sobre todo por el hecho que aún no se tenga una demostración o refutación. Para completar la fascinación por esta conjetura vamos a realizar una representación gráfica de la función de Collatz en los complejos basados en los puntos que convergen y divergen al iterarlos, componer la función con ella misma, continuamente.

La función de Collatz la podemos escribir como :


la podemos extender a los números complejos, como :


Pero esta función no es continua en los enteros, entonces la vamos a modificar por una función que tenga el mismo comportamiento en los enteros pero que allí sea continua:


Observen que aquí, si z es par el primer término es z/2 y el segundo cero, y si z es impar el primer término da cero y el segundo 3z+1. Es decir, se comporta de forma parecida a nuestra función inicial de Collatz, claro está en los números enteros. Como es dispendioso trabajar con el término (-1)^z vamos a utilizar:



de donde obtenemos que :

Ahora, determinando la convergencia después de 20 iteraciones que sea menor a 10^(-6) tenemos :

DensityPlot[
 Length[FixedPointList[(1/4) (2 + 7 # - (2 + 5 #) Cos[\[Pi] #]) &, 
   x + y I, 20, SameTest -> (Abs[#1 - #2] < 10^-6 &)]], {x, -2, 
  2}, {y, -2, 2}, Mesh -> False, PlotPoints -> 100, 
 ColorFunction -> "Rainbow", ImageSize -> 300]



Aquí, vemos de color blanco los puntos de mayor convergencia y cada cambio en los colores hacia las capas exteriores es una zona de menor convergencia que la interior pero mayor que la zona exterior.

Haciendo modificaciones sobre el rango de la gráfica se pueden realizar acercamientos a regiones donde se ve mejor el comportamiento fractal.

DensityPlot[
 Length[FixedPointList[(1/4) (2 + 7 # - (2 + 5 #) Cos[\[Pi] #]) &, 
   x + y I, 20, 
   SameTest -> (Abs[#1 - #2] < 10^-6 &)]], {x, -1, -0.5}, {y, 0, 0.2},
  Mesh -> False, PlotPoints -> 100, ColorFunction -> "Rainbow", 
 ImageSize -> 300]




Basado en el Blog Rhapsody in Numbers aquí


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

No hay comentarios.:

Publicar un comentario