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

unit uplanprueba;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  xMatDefs, Math,
  testCase1;

type
  TPlanPrueba = class;
  TPlanPrueba = class
    idPlan      : Integer;      //identifica unívocamente a cada plan. equivalente a poblacion en TPlan
    raza        : Integer;      //gpa (472) o genético (43366)
    //ADN
    adn         : TDAOfNReal;
    //evaluación
    cnt_evaluaciones         :       Integer; //cant de veces que evalué el plan.
    fCriterio1               :       NReal;

    constructor Create;
    constructor CreateRND;

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

end;
TDAOfTPlanPrueba      =     array of TPlanPrueba;

var
  NElems_adn         :     Integer;     //equivalente al número de años en un TPlan
  adn_minimo         :     NReal;
  adn_maximo         :     NReal;

procedure tamano_adn(tamano : Integer);
procedure minimos_y_maximos_adn(min_adn, max_adn: NReal);

implementation

constructor TPlanPrueba.Create;
begin
  inherited Create;
  setlength(adn, NElems_adn);
  self.idPlan := -1; // sin identificar
end;

constructor TPlanPrueba.CreateRND;
var
   i: Integer;
begin
  Create;
  for i:=0 to NElems_adn-1 do
  begin
    self.adn[i]:=random;
  end;

  self.raza := 43366;
end;

procedure TPlanPrueba.Free;
begin
  setlength(adn, 0);
  inherited Free;
end;

procedure TPlanPrueba.Evaluar;
var
   r:NReal;
begin
  self.fCriterio1:=testCase1.testCase1(self.adn);
end;

function TPlanPrueba.Clonar: TPlanPrueba;
var
  k:    integer;
  bebe: TPlanPrueba;
begin
  bebe := TPlanPrueba.Create;

  for k := 0 to high(bebe.adn) do
    bebe.adn[k] := self.adn[k];
  Result := bebe;
end;

procedure TPlanPrueba.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

     j:=random(length(adn));
     if random < 0.5 then
        adn[j] := min(adn[j] + random*20.0, adn_maximo)
     else
         adn[j] := max(adn[j] - 20.0*random, adn_minimo);

end;

procedure tamano_adn(tamano : Integer);
begin
  NElems_adn := tamano;
end;

procedure minimos_y_maximos_adn(min_adn, max_adn: NReal);
begin
  adn_minimo:=min_adn;
  adn_maximo:=max_adn;
end;

end.

