//esta unit define la clase TPlan que es análoga a la TPlan pero para pruebas.
//M. Forets           @  iie    2011

unit uplanreductor;


{$MACRO ON}
//define el plan particular
//{$define fCriterio1 := Error}
{$define uplan := uplanreductor}
{$define TPlan := TPlanReductor}

interface

uses
  Classes, SysUtils,
  xMatDefs, Math, MatReal,
  testCase1,
  uestados;

type

// TPlan = class;

  TVarReal = class
      xmin, xmax: NReal;
      rangox: NReal;
      xp: pNReal;
      maximo_ValInt: integer;
      constructor create( xmin, xmax: NReal; NBytes: integer; xp: PNReal);
      function getInt: integer;
      procedure SetVal( cromosoma: integer );
  end;


//hola

TPlan = class
    idPlan      : Integer;      //identifica unívocamente a cada plan. equivalente a poblacion en TPlan
    raza        : Integer;      //gpa (472) o genético (43366)
    //adn

    MR, MA: TMatR;

    fenotipo: array of TVarReal;

    //adn : TDAOfNReal;          //concatenaciòn de las filas de MR y las filas de MA
    //evaluación
    cnt_evaluaciones         :       Integer; //cant de veces que evalué el plan.
    fCriterio1               :       NReal;   //es el ERROR

     // y seria el vector de estado de dimension m<n reducido
     x, y: TVectR;
     Xmin,Xmax: NReal;

     kPuntoT, m, n: integer;


    function Diferencia( x: TPlan ) : NReal;

    constructor Create;
    constructor CreateRND;

    procedure   Free;
    procedure   Evaluar;
    function    Clonar       :   TPlan;
    procedure   Mutar;

    //concatena MR y MA fila por fila
    function adn  : TDAOfNReal;

end;

TDAOfTPlanPrueba      =     array of TPlan;


const
  INDTIEMPO=500;


var
  CF: TAdminEstados;
  adn_minimo         :     NReal;
  adn_maximo         :     NReal;


function mezclar(mama, papa: TPlan): TPlan;

implementation



constructor TVarReal.create( xmin, xmax: NReal; NBytes: integer; xp: PNReal );
begin
     self.xmin:= xmin;
     self.xmax:= xmax;
     self.rangox:= xmax-xmin;
     self.xp:= xp;
     self.maximo_ValInt:= 1 SHL (8*NBytes) - 1;
end;

function TVarReal.getInt: integer;
begin
     result:= trunc( (xp^ - xmin) / rangox * Maximo_ValInt );
end;

procedure TVarReal.SetVal( cromosoma: integer );
begin
  xp^:= rangox * ( cromosoma / Maximo_ValInt ) + xmin;
end;


function mezclar(mama, papa: TPlan): TPlan;
var
  k,j:      integer;
  bebe:   TPlan;
begin

  bebe := TPlan.Create;

  for k:= 1 to papa.m do
     for j:= 1 to papa.n do
     begin
          if random < 0.5 then
             bebe.MR.pon_e(k, j, mama.MR.e(k,j))
          else
             bebe.MR.pon_e(k, j, papa.MR.e(k, j));

          if random < 0.5 then
             bebe.MA.pon_e(j, k, mama.MA.e(j,k))
          else
             bebe.MA.pon_e(j, k, papa.MA.e(j, k));
      end;

  bebe.raza:=43366; //indica que este plan provino de la raza genetica

  Result := bebe;
end;



function TPlan.Diferencia( x: TPlan ): NReal;
var
  k: INteger;
  dA, dB: NREal;
begin

  dA:= 0;
  for k:= 1 to MA.nf do
   dA:= dA + MA.pm[k].distancia2( x.MA.pm[k] );

  dB:= 0;
  for k:= 1 to MR.nf do
   dB:= dB + MR.pm[k].distancia2( x.MR.pm[k] );

  result:= max( dA, dB );
end;


Constructor TPlan.Create;
begin
inherited create;
 if CF = nil then
       CF :=  TAdminEstados.CreateLoadFromArchi( 'CF.bin' );
 n:= CF.nVarsContinuas; //cantidad de variables continuas
 m:=  n-2;    //OJO : defino la dimension del nuevo espacio de estados
 y:= TVectR.Create_init( m );   //empieza en 0
 x:= TVectR.Create_init( n );
 MR:= TMatR.Create_Init( m, n );  //empiezo en fila 1 no 0
 MA:= TMatR.Create_init( n, m );
 kPuntoT:= INDTIEMPO;
 (*inicializo a un punto de tiempo luego esto va a tener que ser
   un parametro *)
   (* acordarse que KPuntoT es el indice de tiempo y no el tiempo KPuntoT
   para obtener el tiempo k  hay que hacer N-KPuntoT siendo N la dimension
   del espacio de tiempo*)
 fCriterio1:= 0.0;

 self.idPlan := -1; // sin identificar
end;

constructor TPlan.CreateRND;
var
   k,j: Integer;
   {z:NReal;}
begin
  Create;
   {z:=0;}
  for k:= 1 to n do
      for j:= 1 to m do
      begin
        self.MA.pon_e(k, j, random);
        {z:= Ma.e(k,j);}
      end;

  for k:= 1 to m do
      for j:= 1 to n do
        self.MR.pon_e(k, j, random);

  self.raza := 43366;
end;

procedure TPlan.Free;
begin
  inherited Free;
end;

procedure TPlan.Evaluar;
var
  k:Integer;
  cx, cy: NReal;
  auxe,SumCF2 : NReal;
 begin
  auxe := 0.0;
  sumCF2 := 0;
  CF.setEstrellaCERO;
  repeat
   CF.SetEstadoToEstrella;
   for k:= 0 to CF.nVarsContinuas-1 do
       self.x.pon_e( k+1, CF.xr[k] );
   cx:= CF.costoEstrella( kPuntoT );
   (*a seguir se crea un nuevo vector de estado x multiplicando el viejo
   por las matrices Mr y Ma*)
   self.MR.Transformar( y, x ); (*tomar vector X multiplicarlo por la matriz MR
   y obtener el vector y*)
   self.MA.Transformar( x, y );
   for k:= 0 to CF.nVarsContinuas-1 do
    CF.xr[k]:= self.x.e(k+1);
   (* se calcula el CF para una estrella nueva que no es ninguna de las ya
   conocidas. Para esto se itera *)
   cy:= CF.costoContinuo( kPuntoT );
   (*se calcula costo en %con respecto a costo de la variable de estado incial*)
   auxe := auxe + (sqr(cx - cy ));
   SumCF2 := SumCF2 + sqr(CF.costoEstrella(KpuntoT));
   //SumCF2:= sqr(CF.costoEstrella(KpuntoT))

   (*tenemos una forma de determinar cuando terminamos el algoritmo
   evaluando cuando entre una iteracion y la siguiente ya no mejora mas*)
  until not CF.IncEstrella;
  auxe := auxe/SumCF2;
  self.fCriterio1 := sqrt(auxe)*100;
  //self.fCriterio1 := sqrt( auxe/1e6 );

 end;

function TPlan.Clonar: TPlan;
var
  k, j:    integer;
  bebe: TPlan;
  auxr : NReal;
begin
  bebe := TPlan.Create;

  for k:= 1 to n do
      for j:= 1 to m do
         bebe.MA.pon_e(k,j,self.MA.e(k,j));


  for k:= 1 to m do
      for j:= 1 to n do
         bebe.MR.pon_e(k,j,self.MR.e(k,j));


  Result := bebe;
end;

procedure TPlan.Mutar;
var
  j, k,l: integer;
  B: array of NInt;
  I, Q, D: NInt;
  delta: NReal;
  alfa: NReal;
  nbits: NInt;
  nuevoValor, viejoValor:NReal;
begin

     (*
     //en este caso se elige hacer una mutación binaria con cadenas de un byte
     alfa:=1.05;
     //alfa es un parámetro mayor que uno, la negación de un bit del adn
     //sigue una relación de potencia proporcional al inverso de alfa,
     //siendo más probable negar el LSB

     nbits:=16;
     //nbits da la resolución de las componentes del adn

     //elijo al azar una componente del plan a cambiar
     j := random(length(adn));

     //transformar adn[j] a una cadena binaria escalada
     setlength(B, nbits);
     D := trunc(adn[j]*(2**nbits-1)/adn_maximo);
     I := 0;
     Q := D;
     repeat
           B[I] := Q mod 2 ;
           Q := Q div 2 ;
           I := I + 1 ;
     until Q = 0 ;

     (*
     for l:=0 to I-1 do
     begin
       writeln('B[',l,'] =',B[l]);
     end;
     *)

     //seleccionar al azar el/los bit a flipear, con mayor probabilidad los
     //menos significativos

     for k:=0 to I-1 do
     begin
       if (random <1/alfa**(1+k)) then
       begin
         //bit flip
         if (B[k] = 1) then
            B[k] := 0
         else
            B[k] := 1;
       end;
     end;
     (*
     writeln('B flipeado. . .');
     for l:=0 to I-1 do
     begin
       writeln('B[',l,'] =',B[l]);
     end;
     *)
(*
     //reconvertir a real
     Q:=0;
     for k:=0 to I-1 do
     begin
          Q:=Q+B[k]*(2**k);
     end;

     nuevoValor:=Q*adn_maximo/(2**nbits-1);

     adn[j]:=nuevoValor;
*)

     //codigo anterior

     //mutación sobre MA (n x m)
     k:=1+random(n); //fila al azar
     j:=1+random(m); //columna al azar

     if random < 0.5 then
        MA.pon_e(k,j,MA.e(k,j) + random)
     else
        MA.pon_e(k,j,MA.e(k,j) - random);

     //mutación sobre MR (m x n)
     k:=1+random(m); //fila al azar
     j:=1+random(n); //columna al azar
     if random < 0.5 then
        MR.pon_e(k,j,MR.e(k,j) + random)
       (* *)
     else
        MR.pon_e(k,j,MR.e(k,j) - random);

end;

function TPlan.adn  : TDAOfNReal;
var
  i,k,j   : Integer;
  adnAux : TDAOfNReal;

begin
 setlength(adnAux, 2*m*n);
 i:=0;
 for k:= 1 to m do
     for j:= 1 to n do
     begin
          adnAux[i] := MR.e(k,j);
          i:=i+1;
     end;

 for k:= 1 to n do
     for j:= 1 to m do
     begin
          adnAux[i] := MA.e(k,j);
          i:=i+1;
     end;

 Result := adnAux;
end;

end.

