unit uexplorador_ga;

{$mode delphi}

interface

uses
  Classes, SysUtils,
  Math,
  ufechas,
  u_updownload,
  utipos_ga,
  fddp_conmatr,
  fddp,
  {$IFDEF USE_DB_CON}
  lib_dbmysql,
  {$ELSE}
  uDataSetGenerico,
  urosx,
  {$ENDIF}
  {$IFDEF data_NO_}
  udbconpg,
  {$ENDIF}
  matent, matreal, xmatdefs, uexplorador, uoddface;

type
  { TExploradorGenetico }
  TExploradorGenetico = class(TExplorador)
  public
    constructor Create(dbconx: TDBrosxCon; Problema: TProblema;
      ProbPremioExito_, ProbMutacionDelBit_: NReal);
    function ProponerNuevoIndividuo: TIndividuo; override;
    destructor destroy; override;

  private
    rnd_Mutacion: Tf_ddp_VectDeMuestras;
    ProbPremioExito: NReal;
    ProbMutacionDelBit: NReal;


    // selecciona un progenitor, aplicando la ProbPremioExito
    // para premiar entre el más exitoso o el resto y así
    // sucesivamente dentro de cada resto. El parámetro kMax
    // especifica las posición en la lista ordenada por orden decreciente
    // de mérito del último individuo que se considera candidato.
    // El valor kMax tiene que ser < que la cantidad total de indiviudos
    // en el historial global para que esté asegurado que el resultado
    // es un individuo.
    function SeleccionarProgenitor(kMax: integer): TIndividuo;

    // lo mismo que la anterior, pero sobre la población filtrada por f_objetivo > f_objetivo_piso
    function SeleccionarProgenitor_conPiso(kMax: integer; f_objetivo_piso: NReal): TIndividuo;


    function Mezclar(Mama, Papa: TIndividuo): TIndividuo;
    procedure Mutar(aIndividuo: TIndividuo);
  end;


implementation



(**** Métodos de TExploradorGenetico  **)
constructor TExploradorGenetico.Create(dbconx: TDBrosxCon; Problema: TProblema;
  ProbPremioExito_, ProbMutacionDelBit_: NReal);

var
  k: integer;
  binom_x, binom_pdf, vequiprob: TVectR;

begin
  inherited Create(dbconx, Problema);
  ProbPremioExito := ProbPremioExito_;
  ProbMutacionDelBit := ProbMutacionDelBit_;

  // Creamos una fuente aleatoria que genere la cantidad de bits a mutar
  binom_x := TVectR.Create_Init(problema.nbits_ADN_Justo + 1);
  for k := 1 to binom_x.n do
    binom_x.pv[k] := k - 1;

  binom_pdf := binomial_pdf(problema.nbits_ADN_Justo, ProbMutacionDelBit);

  vequiprob := muestrasEquiprobables(binom_x, binom_pdf, 200);


  rnd_Mutacion := Tf_ddp_VectDeMuestras.Create_SinClonarMuestras(vequiprob, nil, 31 + semilla_maestra );

  binom_pdf.Free;
  binom_x.Free;

end;


destructor TExploradorGenetico.destroy;
begin
  rnd_Mutacion.Free;
  inherited destroy;
end;



 {*****************************************
 ATENCION!! CAMBIO ESTO PARA LO QUE HABIA
 ANTES PORQUE NO ME CONVENCE COMO ESTA
 DANDO PARA LOS PROBLEMAS DE REDES
 NEURONALES DV@20180829
 *****************************************}
  {
function TExploradorGenetico.ProponerNuevoIndividuo: TIndividuo;
var
  Mama, Papa, Bebe: TIndividuo;
  nPoblacion: integer;
  Mama_f_piso: NReal;
  nPoblacionPapas: integer;

begin
  nPoblacion := Problema.CantidadDeIndividuos;
  if nPoblacion >= 20 then
  begin
    Mama := seleccionarProgenitor(nPoblacion - 1);
    if Mama = nil then
    begin
      Mama := rnd_Individuo;
      Papa := seleccionarProgenitor(nPoblacion - 1);
    end
    else
    begin
      Mama_f_piso := Mama.f_objetivo;
      nPoblacionPapas:= Problema.CantidadDeIndividuos_conPiso( Mama_f_piso );
      if nPoblacionPapas > 2 then
        Papa := seleccionarProgenitor_conPiso( nPoblacionPapas - 1, Mama_f_piso)
      else
        Papa:= nil;
    end;

    if Papa = nil then
      Papa := rnd_Individuo;
    Bebe := Mezclar(Mama, Papa);
    mutar(Bebe);
  end
  else
    Bebe := rnd_Individuo;

  // actualizamos los Genotipos
  problema.decodificar_adn(Bebe);
  if problema.viable(Bebe) then
    Result := Bebe
  else
    Result := nil;
end; }




function TExploradorGenetico.ProponerNuevoIndividuo: TIndividuo;
var
  Mama, Papa, Bebe: TIndividuo;
  nPoblacion: integer;
begin
  nPoblacion := Problema.CantidadDeIndividuos;
  if nPoblacion >= 2 then
  begin
    Mama := seleccionarProgenitor(nPoblacion - 1);
    if Mama = nil then
      Mama := rnd_Individuo;
    Papa := seleccionarProgenitor(nPoblacion - 1);
    if Papa = nil then
      Papa := rnd_Individuo;
    Bebe := Mezclar(Mama, Papa);
    mutar(Bebe);
    Mama.Free;
    Papa.Free;
  end
  else
  begin
    //Bebe := TIndividuo.CreateNew(dbcon, Problema);
    //mutar(Bebe);
    Bebe := rnd_Individuo;
  end;

  // actualizamos los Genotipos
  problema.decodificar_adn(Bebe);
  if problema.viable(Bebe) then
  begin
    Result := Bebe;
  end
  else
  begin
    Bebe.Free;
    Result := nil;
  end;
end;







function TExploradorGenetico.SeleccionarProgenitor(kMax: integer): TIndividuo;
var
  k: integer;
  lst: TIndividuos;
begin
  k := 0;
  while (fuente.rnd > self.ProbPremioExito) and (k < kMax) do
    Inc(k);
  lst := problema.SeleccionarMejores( 1, k);
  Result := lst.items[0];
  lst.Free;
end;

function TExploradorGenetico.SeleccionarProgenitor_conPiso(kMax: integer;
  f_objetivo_piso: NReal): TIndividuo;
var
  k: integer;
  lst: TIndividuos;
begin
  k := 0;
  while (fuente.rnd > self.ProbPremioExito) and (k < kMax) do
    Inc(k);
  lst := problema.SeleccionarMejores_conPiso(1, k, f_objetivo_piso );
  Result := lst.items[0];
  lst.Free;
end;

function TExploradorGenetico.Mezclar(Mama, Papa: TIndividuo): TIndividuo;
var
  res: TIndividuo;
  jWord: integer;
  mask: word;
  aw: word;
  dx: NREal;
  kGenotipo: integer;
  ru: NReal;
  dk: integer;

begin
  res := TIndividuo.CreateNew(dbcon, problema);

  ru := fuente.rnd;
  if ru < problema.ro_binary then
  begin
    for jWord := 0 to problema.nwords_ADN - 1 do
    begin
      mask := fuente.randomIntRange(0, $10000 - 1); //random($10000);
      aw := (Mama.ADN[jWord] and mask) or (Papa.ADN[jword] and not mask);
      res.ADN[jWord] := aw;
    end;
  end
  else if ru < (problema.ro_binary + problema.ro_gray) then
  begin
    Mama.toGray;
    Papa.toGray;
    for jWord := 0 to problema.nwords_ADN - 1 do
    begin
      mask := fuente.randomIntRange(0, $10000 - 1); // random($10000);
      aw := (Mama.ADN[jWord] and mask) or (Papa.ADN[jword] and not mask);
      res.ADN[jWord] := aw;
    end;
    res.tipo_COD := C_COD_GRAY; // Aviso que que quedó en codificación GRAY
  end
  else if ru < (problema.ro_binary + problema.ro_gray + problema.ro_unary) then
  begin

    problema.decodificar_adn(Mama);
    problema.decodificar_adn(Papa);

    for kGenotipo := 1 to length(Problema.DescriptoresR) do
    begin
      dx := (Papa.XR.pv[kGenotipo] - Mama.XR.pv[kGenotipo]) * (fuente.rnd * 2 - 0.5);
      dx := Mama.XR.pv[kGenotipo] + dx;
      dx := max(Problema.DescriptoresR[kGenotipo - 1].x_min, dx);
      dx := min(dx, Problema.DescriptoresR[kGenotipo - 1].x_min);
      res.XR.pv[kGenotipo] := dx;
    end;

    for kGenotipo := 1 to length(Problema.DescriptoresE) do
    begin
      dx := (Papa.XE.pv[kGenotipo] - Mama.XE.pv[kGenotipo]) * (fuente.rnd * 2 - 0.5);
      dk := trunc(Mama.XE.pv[kGenotipo] + dx + 0.5);
      dk := max(Problema.DescriptoresE[kGenotipo - 1].k_min, dk);
      dk := min(dk, problema.DescriptoresE[kGenotipo - 1].k_max);
      res.XE.pv[kGenotipo] := dk;
    end;
    problema.codificar_adn(res);
  end
  else
  begin
    //*** FOSIL  Agosto 2011
    // mezcla como las optimizaciones genéticas de agosto 2011
    // Con probabilidad 50% seleccionaba directamente el valor de
    // un individuo o del otro.
    for kGenotipo := 1 to length(Problema.DescriptoresR) do
    begin
      if fuente.rnd < 0.5 then
        res.XR.pv[kGenotipo] := Mama.XR.pv[kGenotipo]
      else
        res.XR.pv[kGenotipo] := Papa.XR.pv[kGenotipo];
    end;

    for kGenotipo := 1 to length(Problema.DescriptoresE) do
    begin
      if fuente.rnd < 0.5 then
        res.XE.pv[kGenotipo] := Mama.XE.pv[kGenotipo]
      else
        res.XE.pv[kGenotipo] := Papa.XE.pv[kGenotipo];
    end;
    problema.codificar_adn(res);
  end;
  Result := res;
end;

procedure TExploradorGenetico.Mutar(aIndividuo: TIndividuo);
var
  nBits: integer;
  jBit, kBit, kWord: integer;
  posBit: integer;
  mask: word;
begin
  nBits := trunc(rnd_Mutacion.rnd + 0.5);

  // si hay mutaciones las ejecutamos
  for jBit := 1 to nBits do
  begin
    // OJO, para ser prolijos aquí habría que verificar
    // si el kBit ya fue mutado y entonces buscar otro.
    // así como está dentro del for, podemos repetir
    // kBits y podría entonces que una mutación anule otra.
    kBit := fuente.randomIntRange(0, problema.nbits_ADN_Justo - 1);
    // random(problema.nbits_ADN_Justo);

    // lo indexamos con el índice de palabra dentro
    // del ADN y una máscara
    kWord := kBit div 16;
    posBit := kBit mod 16;
    mask := 1 shl posBit;

    // invertimos el bit
    aIndividuo.ADN[kWord] := aIndividuo.ADN[kWord] xor mask;
  end;
end;


end.

