Matriz de Autómatas Celulares: Juego de la Vida & Teoría del Impacto Social

PROGRAM JuegoDeLaVida2 (input, output);

{ ******************************************************************************

  El programa crea una poblacion de agentes simples y aplica iterativamente

  las reglas del juego de la vida descritas por John Conway (Gardner, 1970):

  1. Una celula viviente con menos de dos vecinos muere de aislamiento

  2. Una celula con más de tres vecinos muere de sobrepoblacion

  3. Una nueva vida es generada en una casilla vacia con tres vecinos exactamente.

  Tambien calcula la configuracion de las primeras n generaciones aplicando

  las reglas correspondientes a una matriz de M filas y N columnas.

  Version 2.1.0

  Numero de lineas: 410.

****************************************************************************** }

USES CRT, GRAPH, SYSUTILS;

 

CONST

  M = 30; {  Numero de filas  }

  N = 30; {  Numero de columnas  }

  DMilgram = 2;  {  Numero de individuos entre i y j (Definicion de Milgram) }

 

TYPE

  Automatas2D = ARRAY [0..N+2*DMilgram-1, 0..M+2*DMilgram-1] OF smallint; {  Asignación de tipo: arreglo de enteros  }

 

VAR

  GD, GM : smallint;

  Matriz, MatrizVec,  MatrizAlm, MatrizAlmVec, Fortaleza : Automatas2D;

  MUsuario, NUsuario, Vecindad, Liderazgo, i, j, t, EntradaUsuario : Integer;

  Generacion : shortstring;

 

FUNCTION EnteroAleatorio( p, q : integer ) : integer;

{------------Toma dos enteros m y n.

             Genera un entero aleatoriamente seleccionado de m, m+1, ..., m + n - 1.

             Utiliza la funcion Random que genera un numero real aleatorio

             en el intervalo del 0 al 1. Devuelve un entero aleatorio----  }

  BEGIN

    EnteroAleatorio := p + trunc( q * Random )

  END {EnteroAleatorio};

 

PROCEDURE CapturaDeDatos;

  BEGIN

    writeln( '--Ingrese secuencialmente (por columnas) los elementos de la matriz X: ' );

    writeln( '              X =  < Elem11  Elem12 .. Elem1M >' );

    writeln( '                   < Elem21  Elem22 .. Elem2M >' );

    writeln( '                   <   ..      ..        ..   >' );

    writeln( '                   < ElemN1  ElemN2 .. ElemNM >' );

    writeln;

    writeln( '          Automata VIVO = 1    Automata NO VIVO = 0' );

    for i := 1 to NUsuario do

     for j := 1 to MUsuario do read( Matriz[ i, j ] );

    readln

  END;

 

PROCEDURE MatrizNula;

  BEGIN

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do Matriz[ i, j ] := 0

  END;

 

PROCEDURE MatrizUnitaria;

  BEGIN

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do Matriz[ i, j ] := 1

  END;

 

PROCEDURE AsignarAleatorio;

  BEGIN

    Randomize;

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do Matriz[ i, j ] := EnteroAleatorio( 0, 2 )

  END;

 

PROCEDURE ModificarMatriz;

  VAR

  MElemInic, NElemInic, MElemFin, NElemFin : integer;

  BEGIN

    writeln;

    writeln( 'Ingrese secuencialmente la FILA y la COLUMNA del primer elemento a modificar':5 );

    writeln ( 'Elemento inicial:  ':10 );

    read ( MElemInic, NElemInic );

    writeln( 'Ingrese del mismo modo FILA y la COLUMNA del ultimo elemento a modificar':5);

    writeln( 'Elemento final:  ':10 );

    read ( MElemFin, NElemFin );

    writeln;

    writeln( 'Comience a digitar columna a columna un valor entero [0..1] para cada uno ':5 );

    writeln( '   de los elementos del intervalo [Elemento inicial..Elemento final]: ' );

    for i := NElemInic to NElemFin do

     for j := MElemInic to MElemFin do read( Matriz[ i, j ] )

  END;

 

  PROCEDURE ModoCRT;

  BEGIN

    TextColor(YELLOW);

    write( 'X =  < ' );

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do write( Matriz[ i, j ], '  ':1 );

    write( ' >' );

    writeln;

    TextColor(YELLOW);

    write( 'Matriz de vecindades = ');

    writeln;

    for i := 0 to NUsuario + 1 do

      for j := 0 to MUsuario + 1 do write(' <', MatrizVec[ i, j ], '> ':1 );

    TextColor( WHITE );

    writeln

  END;

 

PROCEDURE AplicacionGrafica;

  BEGIN

    ClearDevice;

    Outtextxy( 20, 50, 'X = ' );

    Rectangle( 50, 50, 350, 350 );

    Rectangle( 370, 40, 690, 360 );

    for j := 1 to MUsuario do

      for i := 1 to NUsuario do

          BEGIN

            If Fortaleza[ i, j ] = 1 then

              BEGIN  { Distribucion de probabilidad para creacion de lideres = 0.2; No lideres = 0.8  }

                setcolor( GREEN );

                circle( 45 + 10*i, 45 + 10*j, 4 );

                SetFillStyle( 1, BLUE );

                FloodFill( 45 + 10*i, 45 + 10*j, GREEN )

              END;

            If Matriz[ i, j ] = 1 then setcolor( WHITE ) else setcolor( RED );

            circle( 45 + 10*i, 45 + 10 * j, 4 );

          END;  { ciclo FOR  }

    Outtextxy( 50, 375, 'Automata ' );

    Outtextxy( 50, 385, '    VIVO    = Blanco ' );

    Outtextxy( 50, 395, '    NO VIVO = Rojo ' );

    If ( Liderazgo = 1 ) or ( Liderazgo = 2 ) then

    Outtextxy( 50, 405, '    Lider   = Circulo azul ' );

    Outtextxy( 100, 460, 'Generacion numero' );

    Generacion := IntToStr( t );

    Outtextxy( 250, 460, Generacion );

    Outtextxy( 370, 30, 'Espectro de la matriz de vecindades: ' );

    for i := 0 to NUsuario + 1 do

      for j := 0 to MUsuario + 1 do

        BEGIN

          CASE MatrizVec[ i, j ] OF

            0 : setcolor( RED );

            1, 2 : setcolor( BLUE );

            3, 4 : setcolor( GREEN );

            5, 6 : setcolor( YELLOW );

            7, 8 : setcolor( WHITE );

            Otherwise

              BEGIN

                setcolor( WHITE );

                circle( 375 + 10*i, 45 + 10*j, 4 );

                SetFillStyle( 1, YELLOW );

                FloodFill( 375 + 10*i, 45 + 10*j, WHITE )

              END;

          END;

          circle( 375 + 10*i, 45 + 10 * j, 4 );

          Outtextxy( 350, 375, '    0     : Rojo ' );

          Outtextxy( 350, 385, '    1 - 2 : Azul ' );

          Outtextxy( 350, 395, '    3 - 4 : Verde ' );

          Outtextxy( 350, 405, '    5 - 6 : Amarillo ' );

          Outtextxy( 350, 415, '    7 - 8 : Blanco ' );

          Outtextxy( 350, 425, '  9 o mas : Circulo amarillo ' )

       END;

  END;

 

PROCEDURE VonNewmann;

  BEGIN

    for i := 0 to NUsuario + 1 do

      for j := 0 to MUsuario + 1 do MatrizVec[ i, j ] := 0;

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do

        MatrizVec[ i, j ] := Matriz[ i, j-1 ] + Matriz[ i-1, j ] + Matriz[ i+1, j ] + Matriz[ i, j+1 ]

 

  END;

 

PROCEDURE Moore;

  BEGIN

    for i := 0 to NUsuario + 1 do

      for j := 0 to MUsuario + 1 do MatrizVec[ i, j ] := 0;

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do

        MatrizVec[ i, j ] := Matriz[ i-1, j-1 ] + Matriz[ i, j-1 ] + Matriz[ i+1, j-1 ] + Matriz[ i-1, j ] + Matriz[ i+1, j ] + Matriz[ i-1, j+1 ] + Matriz[ i, j+1 ] + Matriz[ i+1, j+1 ]

  END;

 

PROCEDURE Milgram;

  VAR

  MatrizExt, MatrizVecExt : Automatas2D;

  BEGIN

    for i := 0 to NUsuario + 2*DMilgram - 1 do

      for j := 0 to MUsuario + 2*DMilgram - 1 do

        BEGIN          { Inicialización de matrices  }

          MatrizExt[ i, j ] := 0;

          MatrizVecExt[ i, j ] := 0

        END;

 { Reasignacion de elementos para ajustarlos al marco de vecindad Milgram  }

    for i := DMilgram to NUsuario + 2*DMilgram - 1 do

      for j := DMilgram to MUsuario + 2*DMilgram - 1 do MatrizExt[ i, j ] := Matriz[ i-1, j-1 ];

{  Calculo de la matriz de vecindad extendida }

    for i := DMilgram to NUsuario + 2*DMilgram - 1 do

      for j := DMilgram to MUsuario + 2*DMilgram - 1 do 

        BEGIN

        MatrizVecExt[ i, j ] := MatrizExt[ i-2, j-2 ] + MatrizExt[ i-1, j-2 ] + MatrizExt[ i, j-2 ] + MatrizExt[ i+1, j-2 ] + MatrizExt[ i+2, j-2 ]

                              + MatrizExt[ i-2, j-1 ] + MatrizExt[ i-1, j-1 ] + MatrizExt[ i, j-1 ] + MatrizExt[ i+1, j-1 ] + MatrizExt[ i+2, j-1 ]

                              + MatrizExt[ i-2, j ] + MatrizExt[ i-1, j ] + MatrizExt[ i+1, j ] + MatrizExt[ i+2, j ]

                              + MatrizExt[ i-2, j+1 ] + MatrizExt[ i-1, j+1 ] + MatrizExt[ i, j+1 ] + MatrizExt[ i+1, j+1 ] + MatrizExt[ i+2, j+1 ]

                              + MatrizExt[ i-2, j+2 ] + MatrizExt[ i-1, j+2 ] + MatrizExt[ i, j+2 ] + MatrizExt[ i+1, j+2 ] + MatrizExt[ i+2, j+2 ];

{ Reasignacion inversa de elementos para visualizacion convencional  }

        END;

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do MatrizVec[ i, j ] := MatrizVecExt[ i+1, j+1 ]

  END;

 

PROCEDURE CalcularVecindad;

  BEGIN

    If Vecindad = 1 then VonNewmann else

      If Vecindad = 3 then Milgram else Moore

  END;

 

PROCEDURE AsignarVecindad;

  BEGIN

    writeln( 'Condicion de vecindad?  ' );

    writeln( '-- Vecindad de John von Neumann        : 1' );

    writeln( '-- Vecindad de Moore                   : 2' );

    writeln( '-- Vecindad de Milgram (Distancia = 2) : 3' );

    readln( Vecindad );

    CalcularVecindad

  END;

 

PROCEDURE JuegoDeLaVida;

  BEGIN

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do

        BEGIN

          If MatrizVec[ i, j ] < 2 then Matriz[ i, j ] := 0 else  {  Primera regla  }

            If MatrizVec[ i, j ] > 3 then Matriz[ i, j ] := 0 else {  Segunda regla  }

              If MatrizVec[ i, j ] = 3 then Matriz[ i, j ] := 1; {  Tercera regla  }

        END;

    CalcularVecindad

  END;

 

PROCEDURE FuerzaOpinion;

  BEGIN  {  Generacion aleatoria de la fortaleza de opinion de cada individuo }

    writeln( 'Seleccione el parametro de FORTALEZA DE OPINION (o LIDERAZGO) ');

    writeln( '-- SIN LIDERAZGO individual                                 : 0  ' );

    writeln( '-- Conservar las condiciones actuales de liderazgo:         : 1  ' );

    writeln( '-- Crear LIDERES ( probabilidad = 1/6 = 0.166; Betha = 5 )  : 2 ');

    read(  Liderazgo );

    If Liderazgo = 0 then

      for i := 1 to NUsuario do

        for j := 1 to MUsuario do Fortaleza[ i, j ] := 0

    Else

      If Liderazgo = 1 then

        for i := 1 to NUsuario do

          for j := 1 to MUsuario do Fortaleza[ i, j ] := Fortaleza[ i, j ]

      Else

        BEGIN

          Randomize;

          for i := 1 to NUsuario do

            for j := 1 to MUsuario do

              BEGIN { Distribucion de probabilidad para creacion de lideres = 0.2; No lideres = 0.8  }

                Fortaleza[ i, j ] := EnteroAleatorio( 0, 6 );

                If Fortaleza[ i, j ] > 4 then Fortaleza[ i, j ] := 1  { el aporte de cada individuo lider a la funcion de impacto  }

                  Else Fortaleza[ i, j ] := 0

              END;

        END

  END;

 

PROCEDURE ImpactoSocial;

  CONST

    Betha = 5;     {  Constante de autoapoyo para cada individuo  }

  VAR

    Impacto : Automatas2D;

  BEGIN

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do If Matriz[ i, j ] = 0 then Matriz[ i, j ] := -1;

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do Impacto[ i, j ] := 0;

{  Integracion y ponderacion de las opiniones  }

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do

        BEGIN

          MatrizVec[ i, j ] := MatrizVec[ i, j ] + Betha * Fortaleza[ i, j ];

          Impacto[ i, j ] := MatrizVec[ i, j ]*Matriz[ i, j ] + MatrizVec[ i-1, j-1 ]*Matriz[ i-1, j-1 ] + MatrizVec[ i, j-1 ]*Matriz[ i, j-1 ] + MatrizVec[ i+1, j-1 ]*Matriz[ i+1, j-1 ] + MatrizVec[ i-1, j ]*Matriz[ i-1, j ] + MatrizVec[ i+1, j ]*Matriz[ i+1, j ] + MatrizVec[ i-1, j+1 ]*Matriz[ i-1, j+1 ] + MatrizVec[ i, j+1 ]*Matriz[ i, j+1 ] + MatrizVec[ i+1, j+1 ]*Matriz[ i+1, j+1 ]

        END;

{  Calculo de la funcion de actualizacion - Regla de la mayoria ponderada  }

    for i := 1 to NUsuario do

      for j := 1 to MUsuario do

        BEGIN

          If Impacto[ i, j ] >= 0 then Matriz[ i, j ] :=  1 else

            If Impacto[ i, j ] < 0 then Matriz[ i, j ] := 0;

        END;

    CalcularVecindad

  END {EnteroAleatorio};

 

PROCEDURE Evolucion;

  VAR

    ReglaEvol, NumIteraciones : integer;

  BEGIN     {  Reglas del juego de la vida de John Conway  }

    clrScr;

    writeln( 'Procedimiento de evolucion a evaluar? ' );

    writeln( '-- El JUEGO DE LA VIDA           : 1' );

    writeln( '-- La TEORIA DEL IMPACTO SOCIAL  : 2' );

    readln( ReglaEvol );

    If ReglaEvol = 2 then FuerzaOpinion;

    writeln( 'Cuantas veces desea iterar la regla de actualizacion?' );

    readln( NumIteraciones );

    t := 0;

    While NumIteraciones <> t do

      BEGIN

        If ReglaEvol = 1 then JuegoDeLaVida else ImpactoSocial;

        t := t + 1;

        writeln( '              Generacion numero [ ', t, ' ]' );

        Generacion := IntToStr( t );

        AplicacionGrafica;

        If EntradaUsuario = 1 then

          Outtextxy( 50, 440, 'JUEGO DE LA VIDA - REGLAS DE JOHN CONWAY' ) else

          Outtextxy( 50, 440, 'TEORIA DEL IMPACTO SOCIAL - NOWAK y LEWENSTEIN' );

        Delay( 1000 )

      END;

    END;

 

PROCEDURE AlmacenarEstado;

  BEGIN

    writeln;

    writeln( '--Guardar la configuracion actual                 : 1 ':10 );

    writeln( '--Recuperar el ultimo estado-vecindad almacenado  : 2 ':10 );

    read( EntradaUsuario );

    If EntradaUsuario = 1 then

      BEGIN { Almacenamiento de la configuracion actual  }

        for i := 1 to NUsuario do

          for j := 1 to MUsuario do MatrizAlm[ i, j ] := Matriz[ i, j ];

        for i := 1 to NUsuario do

          for j := 1 to MUsuario do MatrizAlmVec[ i, j ] := MatrizVec[ i, j ];

      END

    Else

      BEGIN  {  Recuperacion del ultimo estado-vecindad almacenado  }

        for i := 1 to NUsuario do

          for j := 1 to MUsuario do Matriz[ i, j ] := MatrizAlm[ i, j ];

        for i := 1 to NUsuario do

          for j := 1 to MUsuario do MatrizVec[ i, j ] := MatrizAlmVec[ i, j ];

      END

  END;

 

PROCEDURE Seleccion;

  BEGIN

    REPEAT

      writeln;

      writeln( '--------------MENU PRINCIPAL----------------' );

      writeln( 'Seleccione cualquiera de estas alternativas  ' );

      writeln( '--Ingresar datos elemento a elemento : 1' );

      writeln( '--Asignar Matriz[ 0..0, 0..0 ]       : 2' );

      writeln( '--Asignar Matriz[ 1..1, 1..1 ]       : 3' );

      writeln( '--Asignar aleatoriamente             : 4' );

      writeln( '--Modificar elementos de la Matriz   : 5' );

      writeln( '--Asignar condiciones de vecindad    : 6' );

      writeln( '--Aplicar reglas de evolucion        : 7' );

      writeln( '--Matriz de estados (grafica)        : 8' );

      writeln( '--Matriz de estados (CRT)            : 9' );

      writeln( '--Almacenar/Recuperar configuracion  : 10' );

      writeln( '--Cerrar aplicacion                  : 11' );

      readln( EntradaUsuario );

      CASE EntradaUsuario OF

        1 : CapturaDeDatos;

        2 : MatrizNula;

        3 : MatrizUnitaria;

        4 : AsignarAleatorio;

        5 : ModificarMatriz;

        6 : AsignarVecindad;

        7 : Evolucion;

        8 : AplicacionGrafica;

        9 : ModoCRT;

        10 : AlmacenarEstado

      END;

    UNTIL EntradaUsuario = 11;

    writeln;

    writeln( '  Presione la tecla [Enter] para terminar el programa ' );

    readln

  END;

 

PROCEDURE Presentacion;

  BEGIN

    TextColor( WHITE );

    writeln( '************** EL JUEGO DE LA VIDA (version 2.1)*************' );

    writeln( 'El programa crea una matriz de automatas inicial de dimension M x N ' );

    writeln( 'que representa a una poblacion de agentes cuyos estados son binarios (0 - 1). ' );

    writeln( 'Aplica iterativamente dos clases de mecanismos de evolucion:');

    writeln( '1. El JUEGO DE LA VIDA de John Conway (Gardner, 1970) ');

    writeln( ' - Una celula viviente con menos de dos vecinos muere de aislamiento' );

    writeln( ' - Una celula con mas de tres vecinos muere de sobrepoblacion ');

    writeln( ' - Una nueva vida es generada en una casilla vacia con tres vecinos exactamente' );

    writeln( '2. La TEORIA DEL IMPACTO SOCIAL de Nowak y Lewenstein (1996) ' );

    writeln;

    writeln( 'Puede evaluar las reglas de acuerdo a tres condiciones de vecindad diferentes: ' );

    writeln( ' A. John von Newmann ' );

    writeln( ' B. Moore ');

    writeln( ' C. Milgram [distancia entre los individuos i y j]');

    writeln;

    writeln( 'En el intervalo [1..30] cuantas filas desea?' );

    read ( MUsuario );

    writeln( 'En el intervalo [1..30] cuantas columnas desea?' );

    read ( NUsuario );

    writeln;

    writeln( '           Iniciando Aplicacion grafica... ' );

    InitGraph( GD, GM, '..\BGI' );

    Outtextxy( 250, 250, 'MATRIZ-ESTADO - Aplicacion grafica' );

    Outtextxy( 250, 260, '   Alt + tab para cambiar al panel de control... ' );

    t := 0

  END;

 

BEGIN {-------------------------- Programa Principal --------------------------}

  Presentacion;

  Seleccion;

  closegraph;

  writeln( 'Cerrando aplicacion...' )

END.