Juego del Caos - Triángulo de Sierpinski

Descargar como Notebook

El matemático Británico Michael Barnsley en 1988 dio a conocer el siguiente proceso. Se parte de tres puntos en una hoja P, Q y R no colineales, no sobre la misma recta, (que llamaremos vértices) y otro punto X (que llamaremos punto de partida), se considera un dado que tiene tres resultados igualmente posibles: P, Q y R. Si el resultado es P nos dirigimos desde X hasta P pero nos quedamos a mitad de camino y allí marcamos punto, si es Q del punto que acabamos de marcar inmediatamente nos dirigimos a Q y también nos quedamos a mitad de camino y allí marcamos punto, y si es R dirigiéndonos a R desde el último punto marcamos a mitad de camino, y así sucesivamente. El resultado que se obtiene al realizar un número considerable de veces este proceso es sorprendente, es el Triángulo de Sierpinski.

A diferencia de otras publicaciones ya realizadas donde se mencionaba este procedimiento, vamos a realizar el procedimiento paso a paso. Primero lanzando el dado y dibujando el punto correspondiente, volviendo a lanzar el dado y así permitiendo realizar el proceso punto a punto, pero también se da la posibilidad de realizarlo de cien en cien puntos.

En Mathematica

lista = {}; n = 1; aa = "P";
Manipulate[If[n == 1, AppendTo[lista, s]]; vertices = {p, q, r}; 
 siguiente[punto_] := (vertices[[cc]] + punto)/2; 
 ran := RandomChoice[{0.33, 0.33, 0.34} -> {1, 2, 3}, 1][[1]];
 sig[punto_] := (vertices[[ran]] + punto)/2; 
 Show[Graphics[{Text["P", p + {0.1, 0.1}], Text["Q", q + {0.1, 0.1}], 
    Text["R", r + {0.1, 0.1}]}, PlotRange -> 2], 
  ListPlot[lista, PlotStyle -> {Red, PointSize[0.005]}]], 
 Text["Dado"], 
 Button[Dynamic[aa], cc = ran; 
  aa = Switch[cc, 1, "P", 2, "Q", 3, "R"]], 
 Text["Generación de Puntos"], Text["Uno por Uno"], 
 Button["Acción", n++; 
  AppendTo[lista, Nest[siguiente, Last[lista], 1]]; n++], 
 Text["Cien en Cien"], 
 Button["Continua", pp = NestList[sig, p, 100]; 
  lista = Join[lista, pp]], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{r, {-1, -1}}, Locator}, {{s, {2, 2}}, Locator, 
  Appearance -> "X"}]

Primeros pasos, se lanza el dado y luego se genera la acción

Algunos pasos más

Generando puntos de cien en cien

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