Saltar al contenido

Creación de un diagrama de bifurcación del mapa logístico.

Solución:

George ya ha proporcionado una solución, pero intentemos construirlo pieza por pieza para que podamos entender lo que estamos haciendo. Viniendo de los mundos de los bucles, MathematicaEl estilo de programación puede resultar confuso.

En primer lugar, necesitamos una forma de representar la función para que se aplique de forma recursiva. Una función pura sería genial para esto. Por ejemplo:

r # (1 - #) &

Entonces usaremos NestList para aplicar esto de forma recursiva un número determinado de veces, en su caso 1000 veces, al valor inicial de $ 0.01 $:

NestList[r # (1 - #) &, 0.01, 1000]

Esto generaría una lista de 1001 elementos (incluido el punto de partida); solo queremos los últimos 100 elementos de esta lista, así que usamos Part (es decir [[...]]) y Span (es decir ;;) para seleccionar aquellos:

NestList[r # (1 - #) &, 0.01, 1000 - 1][[-100 ;;]]

Nos gustaría realizar un seguimiento del valor de $ r $ que generó cada uno de esos valores 100x de la recursividad, por lo que transformamos cada elemento de la lista en una sublista del formulario {r, generatedvalue}, mapeando otra función pura simple {r, #} & en la lista obtenida de NestList (ver Map y su taquigrafía /@):

{r, #} & /@ NestList[r # (1 - #) &, 0.01, 1000][[-100 ;;]]

Ahora necesitamos aplicar esta recursividad a cada valor de $ r $ en su intervalo de interés. Nosotros podemos usar Subdivide para generar dicha lista:

Subdivide[2.8, 4, 1200]

Esto generará una lista de valores de $ 1201 $, es decir, $ 1200 $ subdivisiones igualmente espaciadas según lo solicitado. Usaremos Table para ejecutar la recursividad varias veces, cada vez con un valor diferente de $ r $ de la lista anterior, y guardar el resultado en una variable llamada nestedlist:

nestedlist =
  Table[
    {r, #} & /@ NestList[r # (1 - #) &, 0.01, 1000][[-100 ;;]],
    {r, Subdivide[2.8, 4, 1200]}
  ];

Dimensions[nestedlist]
(*  Out: {1201, 100, 2} *)

La salida de Dimensions nos muestra que nuestro nestedlist contiene 1201 listas, una por valor de $ r $, cada una de las cuales contiene 100 pares de valores, es decir, el {r, generatedvalue} pares que queríamos. Esto está demasiado “anidado”; realmente solo queremos una lista larga de tales pares, por lo que podemos “aplanar” el nivel superior de esta lista anidada, para obtener una lista de $ 1201 times100 = 120100 $ pares. Usamos Flatten (junto con una especificación de nivel, 1) para eso, y guardamos el resultado en flatlist:

flatlist = Flatten[nestedlist, 1];
(* Out: {120100, 2} *)

Ahora estamos listos para trazar estos puntos usando ListPlot:

ListPlot[flatlist]

bifurcación

f[r_] := NestList[ r # (1 - #) &, .01, 1000][[-100 ;;]]
ListPlot[Flatten[Table[ {r, #} & /@ f[r] , {r, 2.8, 4, 1/1000}], 1]]

ingrese la descripción de la imagen aquí

si desea arreglar su enfoque de bucle, debería verse así:

L1 = Subdivide[2.8, 4, 1200];
ListPlot[
 Flatten[Table[
   x = Table[0, {1000}];
   x[[1]] = .01;
   Do[x[[i + 1]] = r*x[[i]] (1 - x[[i]]), {i, 999}];
   {r, #} & /@ x[[-100 ;;]], {r, L1}], 1] ]]
¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)



Utiliza Nuestro Buscador

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *