Iteración y caos

Francisco Javier Pérez González
Departamento de Análisis Matemático
Universidad de Granada

Descripción de la práctica

Considera la función cuadrática g(x) = a x (1 - x), 0 ≤ x ≤ 1, donde a es un parámetro real 0 < a ≤ 4. Te propongo que estudies el comportamiento de la sucesión (Subscript[x, n + 1]) = g((Subscript[x, n])),  (Subscript[x, 1]) = x en función del valor del parámetro a y del valor inicial x. Tu trabajo consiste en leer y entender lo que sigue y realizar los ejercicios que te propongo.

Estudio de la sucesión  (Subscript[x, n + 1]) = a (Subscript[x, n]) (1 - (Subscript[x, n])) para un valor fijo de a en función del valor inicial (Subscript[x, 1]) = x ∈  [0, 1]

Ejercicio 1

a) Define una función   "telaraña[a_, x_, n_]" de tres argumentos: el parámetro a, el valor inicial (Subscript[x, 1]) = x y n∈ℕ, que cuando la ejecutes represente gráficamente en pantalla los puntos ((Subscript[x, k]), (Subscript[x, k])),  ((Subscript[x, k]), g((Subscript[x, k]))),  
      (g((Subscript[x, k])), g((Subscript[x, k])))  1 ≤ k ≤ n - 1 unidos por segmentos junto con las gráficas y = x,  y = g(x). Especifica opciones de color (Hue[0]) y de tamaño (PointSize[0.015]) para los puntos y pasa las opciones gráficas a dicha función (incluye opts___ en la definición de telaraña)).

Sugerencias. Es cómodo que definas una lista con los primeros n-1 términos de la sucesión. A dicha lista puedes aplicar una función definida de forma apropiada usando la primitiva gráfica "Line". También puedes usar la primitiva gráfica "Point" con opciones apropiadas aplicada a "Transpose[{lista,lista}]". Aquí te indico con un ejemplo cómo debe funcionar el comando (no ejecutes la celda porque perderás la gráfica).

telaraña[2.7, 0.036, 10, AspectRatio -> 1];

b) Se dice que (para un valor de a) un punto x∈[0,1] es un punto periódico de g con período k≥2 si x = (Subscript[x, 1]) = (Subscript[x, k + 1]) pero (Subscript[x, j]) ≠ (Subscript[x, 1]) para 1<j<k+1. Calcula un punto periódico con período 4 para a=3.7 y calcula un punto periódico con período 8 para a=4.  Representa las gráficas de las sucesiones correspondientes con el comando "telaraña". Comprueba con NestList que los puntos calculados son efectivamento periódicos con período 4 y 8 respectivamente.
Sugerencia. Utiliza el comando "FindRoot". Es muy conveniente que le pongas nombre a los puntos para poder llamarlos y que Mathematica trabaje con ellos con todas sus cifras significativas

Ejercicio 2

En este ejercicio se trata de estudiar la sucesión  (Subscript[x, n + 1]) = a (Subscript[x, n]) (1 - (Subscript[x, n])) para un valor fijo de a cuando el valor inicial (Subscript[x, 1]) = x ∈  [0, 1] se mueve en un intervalo [u, v]. Para mayor fiabilidad desecharemos los primeros m términos de cada sucesión pues estos pueden tener un comportamiento transitorio poco significativo. Para ello debes definir una función teniendo en cuenta los siguientes puntos:
1 Elegimos un valor del parámetro a (por tanto debes incluir a como variable).
2 Elegimos un intervalo 0≤u<v≤1 (por tanto debes incluir u, v como variables).
3 Dividimos el intervalo [u,v] en partes iguales de longitud inc (por tanto debes incluir inc como variable). 
4 En total tendremos (v-u)/inc + 1 puntos de división de [u,v] que representaremos por (Subscript[x, j]) con 0 ≤ j ≤ (v - u)/inc. Representaremos por (Subscript[x, j, q + 1]) = g[a][(Subscript[x, j, q])] (q=1,2,3...) la sucesión que se obtiene iterando la función g[a] partiendo del valor inicial (Subscript[x, j, 1]) = (Subscript[x, j]). Elegimos un valor de m∈ℕ y calculamos el término m+1-ésimo (Subscript[x, j, m + 1]) de cada una de dichas sucesiones (por tanto debes incluir m como variable).
5 Tomando como valor inicial cada uno de los puntos (Subscript[x, j, m + 1]) calculados en el apartado anterior, iteraremos la función g[a] n-1 veces para obtener una lista con los términos (Subscript[x, j, m + 1]),  (Subscript[x, j, m + 2]),  ... ,  
      (Subscript[x, j, m + n]) de cada una de dichas sucesiones (por tanto debes incluir n como variable). Puedes llamar a esa lista "iteraciones[a_, {u_, v_, inc_}, m_, n_]".
6 Ahora hay que formar una lista con los puntos (u + j inc,  (Subscript[x, j, m + k])) donde para cada valor de j con 0 ≤ j ≤ (v - u)/inc se tiene que 1 ≤ k ≤ n. A esta lista la puedes llamar "puntos[a_, {u_, v_, inc_}, m_, n_]".
Finalmente, con ListPlot (con las opciones PlotStyle->AbsolutePointSize[0.0001], PlotRange->All), representa gráficamente la lista anterior para valores de a igual a 2, 3.3, 3.5, 3.56 y 3.7 eligiendo u=0, v=1, inc=.01, m=n=100 y comenta los resultados obtenidos. 
Sugerencias. Para generar los puntos de división del intervalo [u,v] no uses el comando Table sino el comando Range que es más rápido. Para obtener los puntos (Subscript[x, j, m + 1])no uses un Do ni un For (son lentos en Mathematica). Es mucho más rápido proceder como te indico a continuación. Teniendo en cuenta que la aritmética de Mathematica es distributiva con un solo comando que encadene NestList y Nest  puedes generar n listas (una para cada valor de k) con los puntos (Subscript[x, j, m + k]). Observa bien lo que hace el siguiente comando.

f[x_] := 2  xRange[ .1,  .2,  .02]val = Nest[f, Range[ .1,  .2,  .02], 2]NestList[f, val, 3]NestList[f, 0.4, 3]Clear[f, val]

Si lo has entendido bien, con un solo comando (que no ocupa ni una línea de código) que encadene Transpose, NestList, Nest, Range lograrás lo que se pide en los apartados 3, 4 y 5. Ahora sólo te queda emparejar cada uno de los puntos (Subscript[x, j]) = (Subscript[x, j, 1]) con todos los puntos (Subscript[x, j, m + 1]),  (Subscript[x, j, m + 2]),  ... ,  
      (Subscript[x, j, m + n]) donde 0 ≤ j ≤ (v - u)/inc y ponerlos en una lista. Hay muchas formas de hacer esto. El siguiente comando te da una pista muy útil.

Inner[List, {1, 2}, {{3, 4, 5}, {6, 7, 8}}, List]

Puede que necesites usar el comando Flatten (consulta la ayuda). Finalmente, te aconsejo que uses Union para ordenar y eliminar posibles repeticiones.

Estudio de la sucesión  (Subscript[x, n + 1]) = a (Subscript[x, n]) (1 - (Subscript[x, n]))  en función de a  para un valor fijo del punto inicial (Subscript[x, 1]) = x ∈  [0, 1]

Ejercicio 3

Modificando de manera apropiada las funciones definidas en el ejercicio anterior, define una función "bifurcacion[{a0_, a1_, inc_}, x_, m_, n_]" que proporcione como salida una lista con los puntos  ((Subscript[a, j]),(Subscript[x, j, m + k])), 0 ≤ j ≤ (a1 - a0)/inc, 1≤k≤n, donde (Subscript[a, j]) = a0 + j inc y (Subscript[x, j, q + 1]) = g[(Subscript[a, j])][(Subscript[x, j, q])]. Representa bifurcacion[{0, 4, .01}, .4, 100, 100] y bifurcacion[{3.8, 3.9, .001}, .4, 100, 100]. Comenta los resultados obtenidos.