Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

martes, 3 de marzo de 2020

Juego de la Vida: Segunda Parte - Variantes


Desde la creación del juego se han desarrollado nuevas reglas. El juego estándar, en que nace una célula si tiene 3 células vecinas vivas, sigue viva si tiene 2 o 3 células vecinas vivas y muere en otro caso, se simboliza como "23/3". El primer número o lista de números es lo que requiere una célula para que siga viva, y el segundo es el requisito para su nacimiento. Así, "16/6" significa que "una célula nace si tiene 6 vecinas y vive siempre que haya 1 o 6 vecinas". HighLife ("Alta Vida") es 23/36, porque es similar al juego original 23/3 solo que también nace una célula si tiene 6 vecinas vivas. HighLife es conocida sobre todo por sus replicantes, formas que crean copias de ellas mismas. Se conocen muchas variaciones del juego de la vida, aunque casi todas son demasiado caóticas o demasiado desoladas. 

⨷  /3 (estable) casi todo es una chispa
⨷ 5678/35678 (caótico) diamantes, catástrofes
⨷ 1357/1357 (crece) todo son replicantes
⨷ 1358/357 (caótico) un reino equilibrado de amebas
⨷ 23/3 (complejo) "Juego de la Vida de Conway"
⨷ 23/36 (caótico) "HighLife" (tiene replicante)
⨷ 2/7 (caótico) "Diffusion Rule"
⨷ 235678/3678 (estable) mancha de tinta que se seca rápidamente
⨷ 245/368 (estable) muerte, locomotoras y naves
⨷ 34/34 (crece) "Vida 34"
⨷ 4/2 (crece) generador de patrones de alfombras
⨷ 51/346 (estable) "Larga vida" casi todo son osciladores

Clear[ca];
vecino[i_, j_] := 
 Piecewise[{{Sum[bb[[i + k, j + l]], {k, 0, 1}, {l, 0, 1}], 
     i == 1 && j == 1}, {Sum[
      bb[[i + k, j + l]], {k, -1, 0}, {l, -1, 0}], 
     i == cuadro && j == cuadro},
    {Sum[bb[[i + k, j + l]], {k, 0, 1}, {l, -1, 0}], 
     i == 1 && j == cuadro},
    {Sum[bb[[i + k, j + l]], {k, -1, 0}, {l, 0, 1}], 
     i == cuadro && j == 1}, {Sum[
      bb[[i + k, j + l]], {k, 0, 1}, {l, -1, 1}], 
     i == 1}, {Sum[bb[[i + k, j + l]], {k, -1, 0}, {l, -1, 1}], 
     i == cuadro}, {Sum[bb[[i + k, j + l]], {k, -1, 1}, {l, 0, 1}], 
     j == 1}, {Sum[bb[[i + k, j + l]], {k, -1, 1}, {l, -1, 0}], 
     j == cuadro}}, Sum[bb[[i + k, j + l]], {k, -1, 1}, {l, -1, 1}]] -bb[[i, j]]

Ahora, definimos la función ca[ , ], la cual aplica las reglas de evolución del juego.

ca[i_, j_] := 
 Module[{vec = 0}, vec = vecino[i, j]; 
  Piecewise[{{1, (bb[[i, j]] == 0 && 
        vec == 3) || (bb[[i, j]] == 1 && (vec == 2 || vec == 3))}, {0,bb[[i, j]] == 1 && (vec == 0 || vec == 1 || vec > 3)}, {0, (bb[[i, j]] == 0 && vec != 3)}}]]

Definimos cuadro como el tamaño de la rejilla cuadrada, y las formas iniciales de cada patrón.

cuadro = 40;
n = 1;
cero = Table[0, {i, cuadro}, {j, cuadro}];
bb1 = ReplacePart[
   cero, {{2, 2}, {3, 3}, {4, 1}, {4, 2}, {4, 3}, {12, 3}, {14, 
      3}, {15, 4}, {15, 5}, {15, 6}, {15, 7}, {14, 7}, {13, 7}, {12, 
      6}, {21, 2}, {22, 3}, {22, 4}, {22, 5}, {22, 6}, {22, 7}, {21, 
      7}, {20, 7}, {19, 6}, {19, 2}, {18, 4}} -> 1];
bb2 = ReplacePart[
   cero, {{3, 3}, {2, 4}, {2, 5}, {3, 6}, {4, 4}, {4, 5}, {3, 10}, {3,11}, {4, 10}, {4, 11}, {8, 11}, {9, 11}, {10, 12}, {10, 13}, {7,12}, {8, 13}, {9, 14}, {9, 3}, {8, 4}, {8, 5}, {9, 6}, {10, 3}, {10, 6}, {11, 4}, {11, 5}, {18, 11}, {18, 12}, {17,11}, {16, 12}, {16, 13}, {17, 13}} -> 1];
bb3 = ReplacePart[
   cero, {{4, 4}, {4, 5}, {4, 6}, {5, 5}, {5, 6}, {5, 7}, {4, 12}, {4,13}, {4, 14}} -> 1];
bb4 = ReplacePart[
   cero, {{20, 20}, {20, 21}, {18, 21}, {19, 23}, {20, 24}, {20,25}, {20, 26}} -> 1];
bb5 = ReplacePart[
   cero, {{20, 20}, {20, 21}, {21, 21}, {21, 25}, {21, 26}, {21,27}, {19, 26}} -> 1];
bb6 = ReplacePart[
   cero, {{6, 1}, {6, 2}, {7, 1}, {7, 2}, {6, 11}, {7, 11}, {8, 11}, {5, 12}, {4, 13}, {4, 14}, {9, 12}, {9, 16}, {10, 13}, {10,14}, {5,16}, {6, 17}, {7, 17}, {8, 17}, {7, 15}, {7, 18}, {4, 21}, {5,21}, {6, 21}, {4, 22}, {5, 22}, {6, 22}, {3, 23}, {7, 23}, {2, 25}, {3, 25}, {7, 25}, {8, 25}, {5, 35}, {5, 36}, {4, 35}, {4, 36}} -> 1];
bb7 = Mod[Array[Binomial, {cuadro, cuadro}, 0], 2];

Generamos la posibilidad de cambiar las reglas de sobre vivencia y muerte según el número de vecinos de cada celda.

gg = False;
Manipulate[
 cal[i_, j_] :=
  Module[{vec = 0}, vec = vecino[i, j];
   Piecewise[{{1, (bb[[i, j]] == 0 &&
         MemberQ[na, vec]) || (bb[[i, j]] == 1 &&
         MemberQ[so, vec])}, {0,
      bb[[i, j]] == 1 &&
       FreeQ[so, vec]}, {0, (bb[[i, j]] == 0 && FreeQ[na, vec])}}]];
 If[n == 1, bb = aa]; m = Total[bb, 2]; If[m == 0, gg = False];
 If[gg, t = True; n++];
 If[t == True, bb = Table[cal[i, j], {i, cuadro}, {j, cuadro}];
  t = False;
  MatrixPlot[bb, Mesh -> False, Frame -> False],
  MatrixPlot[bb, Mesh -> False, Frame -> False]], Text["Reglas Según el número de Vecinos"],
 Control[{{so, {2, 3}, "Sobrevive"}, Range[8], TogglerBar}],
 Control[{{na, {3}, "Nace"}, Range[8], TogglerBar}], Text[""],
 Text["Configuración Inicial"], {{aa, bb1,
   "Motivo"}, {bb1 -> "Naves", bb2 -> "Estable", bb3 -> "Oscilador",
   bb4 -> "Larga Vida 1", bb5 -> "Larga Vida 2", bb6 -> "Cañón"},
  ControlType -> SetterBar}, Text[""], Text["Desarrollo del Juego"],
 Button["Evolución", n++; gg = True; t = True, ImageSize -> 100],
 Button["Parar", gg = False,
  ImageSize -> 100], {{n, 1, "Número de Vida:"},
  Appearance -> Open}, {{m, 0, "Población:"}, Appearance -> Open},
 Button["Limpiar", n = 1; t = False; gg = False; aa = cero,
  ImageSize -> 100]]








Se han desarrollado variantes adicionales mediante la modificación de otros elementos del universo. Las variantes anteriores son para un universo bi dimensional formado por cuadrados, pero también se han desarrollado variantes unidimensionales y tridimensionales, así como variantes 2 - D donde la malla es hexagonal o triangular en lugar de cuadrada.


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


No hay comentarios.:

Publicar un comentario