1 2 3 4 5 6 7 8 9 10 11

Programas

Estos programas computacionales, se adjuntan con la finalidad de que usted pueda experimentar con ellos, los dos primeros en Mathematica y otros tres en Logo. Sobre el tema de recursividad en logo puede consultar [2], en donde se dan varios programas para la curva de Koch, el copo de nieve, triángulo de Sierpinski, curvas dragones, etc. Además, usted puede descargar el programa Fract.exe que luego de descomprimirlo, obtiene el Fractint, en este puede obtener los conjuntos de Julia, Mandelbrot, etc. y jugar a construir sus propias figuras fractales.  Por último, en la dirección de Internet www.iterated.com usted puede navegar por la librería, y conseguir el decodificador de imágenes, de uso libre, y el codificador de imágenes, que requiere de licencia, para los formatos .FIF.

1. A=Table[1,{i,1,2},{j,1,2}];
   A[[1,1]]=.849;A[[1,2]]=-.037;A[[2,1]]=.037;A[[2,2]]=.849;
   B=Table[1,{i,1,2},{j,1,2}];
   B[[1,1]]=0.197;B[[1,2]]=0.226;B[[2,1]]=-0.226;B[[2,2]]=0.197;
   Ci=Table[1,{i,1,2},{j,1,2}];
   Ci[[1,1]]=-.15;Ci[[1,2]]=.26;Ci[[2,1]]=.283;Ci[[2,2]]=.237;
   Da=Table[1,{i,1,2},{j,1,2}];
   Da[[1,1]]=0;Da[[1,2]]=0;Da[[2,1]]=0;Da[[2,2]]=.16;
   F1[{x_,y_}]={x,y}.A+{.075,.183};
   F2[{x_,y_}]={x,y}.B+{0.4,.049};
   F3[{x_,y_}]={x,y}.Ci+{.575,-.084};
   F4[{x_,y_}]={x,y}.Da+{.5,0};k=6;
   X=Table[{0,0},{i,1,4^(k+1)}];
   X[[1]]=F1[{0,0.5}];
   X[[2]]=F2[{0,0.5}];
   X[[3]]=F3[{0,0.5}];
   X[[4]]=F4[{0,0.5}];
   i=4; j=5;
   While[j< 4^(k+1)+1,
   X[[j]]=F1[X[[Floor[j/4]+1]]];
   X[[j+1]]=F2[X[[Floor[j/4]+1]]];
   X[[j+2]]=F3[X[[Floor[j/4]+1]]];
   X[[j+3]]=F4[X[[Floor[j/4]+1]]];
   j=j+4]; ListPlot[X,
   Axes->False,AspectRatio->2/1,Prolog->AbsolutePointSize[1]]
   

2. A=Table[1,{i,1,2},{j,1,2}];
   A[[1,1]]=.849;A[[1,2]]=-.037;A[[2,1]]=.037;A[[2,2]]=.849;
   B=Table[1,{i,1,2},{j,1,2}];
   B[[1,1]]=0.197;B[[1,2]]=0.226;B[[2,1]]=-0.226;B[[2,2]]=0.197;
   Ci=Table[1,{i,1,2},{j,1,2}];
   Ci[[1,1]]=-.15;Ci[[1,2]]=.26;Ci[[2,1]]=.283;Ci[[2,2]]=.237;
   Da=Table[1,{i,1,2},{j,1,2}];
   Da[[1,1]]=0;Da[[1,2]]=0;Da[[2,1]]=0;Da[[2,2]]=.16;
   F1[{x_,y_}]={x,y}.A+{.075,.183};
   F2[{x_,y_}]={x,y}.B+{0.4,.049};
   F3[{x_,y_}]={x,y}.Ci+{.575,-.084};
   F4[{x_,y_}]={x,y}.Da+{.5,0};
   k=13000;        (*Numero de puntos que plotea*)
   X=Table[{0,0},{i,1,k}];
   X[[1]]=F1[{.5,0.2}];
   i=4; j=2;
   While[j< k+1, RAN=Random[Integer,{0,100}];
       If       (* Los p_i son las probabilidades en el RIFS*)
   [RAN<p_1,
       X[[j]]=F1[X[[j-1]]],
       If[RAN<p_2,
          X[[j]]=F2[X[[j-1]]],
            If[RAN<p_3,
           X[[j]]=F3[X[[j-1]]],
     X[[j]]=F4[X[[j-1]]]]]
   ];
   j=j+1;
   If[Mod[j-1,k/4]==0,X[[1]]=F1[{.5,0.2}]]
   ];
   ListPlot[X,
   Axes->False,AspectRatio->2/1,Prolog->
   AbsolutePointSize[1]]
   

3. to Koch :depth :size
       if :depth=0 [forward :size stop]
       Koch :depth-1 :size/3
       left 60
       Koch :depth-1 :size/3
       right 120
       Koch :depth-1 :size/3
       left 60
       Koch :depth-1 :size/3
   end
   

4. to heighway :depth :size :parity
       if :depth=0 [forward :size stop]
       left :parity*45
       heighway :depth-1 :size*:factor 1
       right :parity*90
       heighway :depth-1 :size*:factor (-1)
       left :parity*45
   end
   

5. Triangulo de Sierpinski
   to ens :d :s
   pu
   left 120
   forward :s
   right 120
   pd
   make "p 1
   repeat 6 [ sd :d :s (-:p) right 60 make "p :p*-1  ]
   end
   to SD :d :s :p
       if :d=0*:p [forward :s stop]
       left 60*:p
       SD :d-1 :s/2 (:p)
       right 60*:p
       SD :d-1 :s/2 (-:p)
       right 60*:p
       SD :d-1 :s/2 (:p)
       left 60*:p
   end
   

1 2 3 4 5 6 7 8 9 10 11