unit uoddface;
{$DEFINE CONTROLAR_WALLTIME}
{xDEFINE USE_DB_CON}
(**
Proyecto ANII FSE 18-2009
Módulo de Optimización Distribuida de Funciones de Alto Costo de Evaluación ODDFACE.
**)

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;


{$IFDEF CONTROLAR_WALLTIME}
const
  HORAS_WALLTIME = 11.5;
{$ENDIF}


var
  flg_BAJAR_SALA: boolean;
// esta variable se pone a true al inicializar la unidad.
// se puede bajar a FALSE en modo debug para no pasar por la bajada de la
// sala que consume tiempo.

const
  FACTOR_MARGEN_PISO = 1.0001;

type
  {$IFDEF data_NO_}
  TDBPQCon_data = udbconpg.TDBPQCon;
  {$ENDIF}

  TProblema = class; // se define más adelante

  { TIndividuo }

  TIndividuo = class
    problema: TProblema; // problema al que pertenece.
    tipo_COD: integer; // 0 = BINARY, 1 = GRAY, 2 = UNARY

    nid: integer; // -1 si no está asignado

    // Estos parámetros son los que representan el Genotipo del individuo
    XR: TVectR;
    XE: TVectE;

    // El ADN es lo que determina en conjunto con los descriptores de Genotipo
    // el  Genotipo
    ADN: TCadenaADN;

    f_VE, f_VaR, f_CVaR, f_MIN, f_MAX, f_objetivo: NReal;
    // Valor Esperad, Value At Risk y Valor Objetivo VO = ( 1-CAR) FVE + CAR * [ FVaR | CFVaR ]
    cnt_evaluaciones: integer; // Número de evaluaciones realizadas del punto.
    f_histo: TVectR;

    // Conector a la db
    dbcon: TDBrosxCon;

    // crea un nuevo individio "limpio".
    constructor CreateNew(dbconx: TDBrosxCon; problema_: TProblema);

    // crea un individuo con un ADN dado poniendo a cero todos los demás parámetros.
    // es útil para decodificar la cadena.
    constructor CreateFromADN_HexStr(dbconx: TDBrosxCon; problema_: TProblema;
      ADN_HexStr: string);


    // crea un individo desde un record de la DB
    constructor CreateFromRec(dbconx: TDBrosxCon; problema_: TProblema; r: TDataRecord);

    // comunica el resultado al la DB
    procedure ComunicarResultado(numero_de_evaluacion: integer);

    // convierte el ADN a codificacion GRAY
    procedure toGray;

    // convierte el ADN a codificación BINARY
    procedure toBinary;


    function ADN_AsBinaryStr: string;
    destructor destroy; override;
  end;

  TIndividuos = class(TList)
  end;




  { TProblema }

  TProblema = class
    nid_Problema: integer; // identificador único asignado externamente al problema.
    idEjecutor: integer; // número único GLOBAL de la instancia.
    tmp_rundir: string;

    estado_arranque: integer;
    // valor positivo del estado de arranque para que funcione terminar si
    // el estado del problema lo supera. Quiere decir que por alguna razón se dio PARAR y CONTINUAR
    // lo obligamos a TERMINAR para que se inicie otro demonio que lea todos los parámetros
    // del problema.

    fecha_primer_etapa: TFecha;
    dias_por_etapa: integer;
    n_etapas: integer;

    Explorador_GA: pointer; // TExploradorGenetico;
    Explorador_EG: pointer; // TExploradorEstimacionGradiente;
    Explorador_MJ: pointer; // TExploradorMejorador;


    DescriptoresR: TDescriptoresGenotiposReales;
    DescriptoresE: TDescriptoresGenotiposEnteros;
    nbits_ADN_Justo, nbits_ADN_Resto: integer;
    mascara_Resto: word;

    nwords_ADN: integer; // ceil( nbits_ADN / 16.0 )
    nbytes_ADN: integer; // nbytes_ADN = nwords_ADN * 2

    NCronicasCronicasPorVez: integer;
    // cantidad de crónicas a ejecutar en cada oportunidad

    semilla_madre: integer; // semilla aleatoria MADRE del problema.
    // habría que hacer que cada evaluación tenga un número único y por consiguiente
    // usar dicho número para FIJAR la semilla del ejecutor. Así podríamos tener
    // algo reproducible. Por ahora NO se usa y cada uno genera números aleatorios
    // en forma "descordinada".

    pe_var: NREal; // por defecto 0.05 = 5%
    N_DiscrtetizacionesHistograma: integer;
    ro_VE, ro_VaR, ro_CVaR: NReal;
    // Pesos de VE, VaR y CVaR para la formación del objetivo.

    // En el Create se debiera definir la DIMENSION del problema
    // creado los descriptores de parámetros y fijar
    // los valores:
    // * pe_Var = Probabilidad con que se calcula VaR y CVaR
    // * NDiscretizacionHistograma = Cantidad de puntos usados para almacenar los histogramaas de F(X)
    // * car_VaR y car_CVaR = Coeficientes de Aversión al Riesgo con que se consideran las medidas VaR y CVaR
    // * ambos coeficienes deben ser >= 0 y sumar <= 1.
    // La función objetivo de calcula como ro_VE * f_VE + ro_VaR * f_VaR + ro_CVaR * f_CVaR

    // La creación del problema crea un EJECUTOR local del problema, para el IdSolucion
    // Se supone que al iniciar una solución de un tipo de problema, se crea en LA NUBE un
    // repositorio donde se guardan los individuos evaluados.
    // Al crear el problema local, se realiza una conexión con el repositorio para obtener
    // la información de avance de la solución.

    // Estos tres parámetros representa PESOS y son la probabilidad con que
    // el resolverdor podría elegir entre tres tipos de Exploradores de resolución.
    // El Explorador por Algoritmos Genéticos (GA) es el primero implementado.
    // El Explorador por Estimación del Gradiente (EG) es el segundo (en estado de implementación)
    // y Explorador MEJORADOR (MJ) es simplemente un explorador que en lugar de proponer un nuevo PUNTO
    // elije mejorar la estimación de un punto existene imponiendo una nueva evaluación del mismo.
    ro_GA, ro_EG, ro_MJ: NReal;
    ro_GA_or_MJ: NReal;


    // El tipo de codificación determina la cadena de ADN sobre la que se aplica el mecanismo
    // de cross-over y de mutación.
    // En Binary, el ADN es la representación binaria directa del rango entero del parámetro.
    // en este caso dos cadenas que difieren en solo un bit como 1000 y 0000 pueden representar
    // individuos que en el mundo real tengan una diferencia muy importante.
    // En la representación GRAY dos individuos vecinos en el mundo real difieren en solo un bit
    // entre si.
    // En la representacion UNARY, cada indiduo es representado por una población de bits cuya
    // de forma tal que la cantidad de unos en la cadena representa el valor del parámetro.
    // Esto llevaría a cadenas más largas y a una codificación reduntante. El cruzamiento
    // en esta representación implica tomar un número aleatorio entre el CERO y el valor
    // del parámetro para cada indiviuo formar el individuo SUMA de ambos valores (/2 para mantener el rango)
    ro_binary, ro_gray, ro_unary, ro_fosil_agosto2011: NReal;

    // La probabilidad de premiar el éxito, se utiliza para asignar la probabilidad
    // de reproducción entre el más exitoso y el resto de cualquier conjunto de
    // individuos.
    GA_prob_premio_exito: NReal;

    // Probabilidad de Mutación de un BIT del ADN
    GA_prob_mutacion: NReal;

    // archivo sala SimSEE
    archiSala: string;

    // Tipo de problema.
    //      0: base (no requiere más info).
    //      1: PIGSimSEE requiere lista de teconologías a considerar.
    //      2: PAMSimSEE requiere lista de centrales a considerar.
    tipo: integer;

    // estado 0 = Ejecución deteninda; 1 = En ejecución.
    estado: integer;


    dbcon: TDBrosxCon;

    constructor Create(dbconx: TDBrosxCon; recProblema: TDataRecord;
      idEjecutor_: integer; tmp_rundir_: string);

    destructor destroy; override;

    // nombre de la tabla de individuos en el servidor de base de datos
    function db_table: string;


    // Definir descriptor parámetro Real;
    // kPar = [0 .. NParametrosReales-1];
    procedure DefinirParametroReal(kPar: integer; Nombre: string;
      xMin, xMax: NReal; nbits: integer);

    // Definir descriptor parametro Entero;
    // kPar = [0 .. NParametrosEnteros-1];
    procedure DefinirParametroEntero(kPar: integer; Nombre: string; kMin, kMax: integer);


    // Calcular nbits_ADN nbytes_ADN y nwords_ADN
    // esta función debe ser llamada luego de terminar de agregar los parámetros al problema
    // para que quede definido el largo de los buffers de ADN necesarios.
    procedure CalcularLargosADN;

    // realiza una evaluación del punto.
    // sobreescribir este método con el problema concreto a resolver.
    // el resultado de la evaluación tienen que ser agregar NCronicas valores
    // de evaluación del punto al histograma hF y actualizar los valores
    // FMed, FVaR y NEVals
    // Retorna TRUE si el individuo es factible y la evaluación se realizó.
    // Retorna FALSE si el individuo es INFACTIBLE y la evaluación no se realizó.
    function evaluar_(indi: TIndividuo; SemillaAleatoria: integer): boolean;
      virtual; abstract;

    // testea la viabilidad del individuo.
    // Es útil, para no evaluar individuos infactibles.
    // Cada problema puede refinar la forma de detección de inviables.
    // Por defecto, se testea que el individuo tenga los parámetros en La Caja.
    function viable( var indi: TIndividuo ): boolean; virtual;

    // revisa si el individuo está en LA CAJA. Si en alguna dimensión se escapa
    // de La Caja, lo encajona. Retonra la cantidad de dimensiones sobre las
    // que tuvo que actuar. Si retorna 0 (Cero) el individuo estaba en la caja.
    function encajonar( var indi: TIndividuo ): integer; virtual;


    // Calcula el Genotipo a partir de la cadena de ADN
    function decodificar_adn(var indi: TIndividuo): boolean; // XR, XE <- ADN

    // Calcula la cadena de ADN para el Genotipo
    procedure codificar_adn(var indi: TIndividuo); // ADN <- XR, XE

    // Genera un ADN aleatorio.
    procedure random_adn(var indi: TIndividuo);


    // Aplica la máscara al último word del ADN. Sirve para limpiar
    // bits residuales por la representación en múltiplos de 16bits.
    procedure LimpiarResto(var indi: TIndividuo);


    // Consulta a la base de datos contar la cantidad de individuos evaluados.
    function CantidadDeIndividuos: integer;

    // Consulta a la base de datos contar la cantidad de individuos evaluados.
    // con f_objetivo > f_objetivo_piso
    function CantidadDeIndividuos_conPiso(f_objetivo_piso: NReal): integer;

    // Rentorna la cantidad de individuos con cnt_evaluaciones < 0
    function CantidadDeIndividuos_PorEvaluar: integer;

    // Consulta a la base de datos contar la cantidad de evaluaciones realizadas.
    // Como el mismo individuo puede ser evaluado más de una vez, se cumple que
    // CantidadDeEvaluaciones >= CantidadDeIndividuos
    function CantidadDeEvaluaciones: integer;

    // busca un individuo en la DB por su identifcaor
    function LeerIndividuo(nid: integer): TIndividuo;

    // Selecciona del Historial Global el primer individuo con cnt_evaluaciones < 0
    // y le pone cnt_evaluaciones = 0
    function SeleccionarIndividuo_PorCalcular: TIndividuo;

    // Selecciona del Historial Global los nME mejores individuos
    // desde la posición "dese" del mejor al peor.
    // Si desde = 0 se seleccionan los nME mejores.
    function SeleccionarMejores(nME, desde: integer): TIndividuos;

    // lo mismo que lo anterior pero sobe la población filtrada por f_objetivo > f_objetivo_piso
    function SeleccionarMejores_conPiso(nME, desde: integer; f_objetivo_piso: NReal): TIndividuos;


    // Entra en el bucle de exploración.
    // sale del bucle si por se le da la señal de terminación al proceso local
    // se desactiva el problema, o en el caso del cluster de FING si se le da
    // una invitación a retirarse para hacer espacio para otros procesos.
    // Primero crea los Exploradores GA, EG y MJ
    function Explorar: integer;

    // testea si hay orden de parar
    function Terminar: boolean; virtual;
  end;

// intetentamos que falle al compilar cualquier unidad que use directamente
// randomize o random
procedure randomize(x: boolean);
function random(x: boolean): boolean;

var
  semilla_maestra: integer; // se inicializa como StrToInt( paramStr(1) ) + StrToInt( paramStr( 2 ) )
  fuente: TMadreUniforme;


implementation
uses
  uexplorador_mj, uexplorador_ga, uexplorador_eg;


procedure randomize(x: boolean);
begin
  // solo para que se rompa
  raise Exception.Create('llamada a randomize en uoddface');
end;

function random(x: boolean): boolean;
begin
  // solo para que se rompa
  raise Exception.Create('llamada a random en uoddface');
  Result := True;
end;


(********** Métodos de TIndividuo ***********************)

// crea un nuevo individio "limpio".
constructor TIndividuo.CreateNew(dbconx: TDBrosxCon; problema_: TProblema);
begin
  problema := problema_;
  nid := -1;
  XR := TVectR.create_init(length(problema.DescriptoresR));
  XE := TVectE.Create_init(length(problema.DescriptoresE));
  tipo_COD := C_COD_BINARY;
  setlength(adn, problema.nwords_ADN);
  f_VE := 0;
  f_VaR := 0;
  f_CVaR := 0;
  f_Objetivo := 0;
  cnt_Evaluaciones := 0;
  f_Histo := TVectR.Create_init(problema.N_DiscrtetizacionesHistograma);
  dbcon := dbconx;
end;


constructor TIndividuo.CreateFromADN_HexStr(dbconx: TDBrosxCon;
  problema_: TProblema; ADN_HexStr: string);
var
  s: string;
begin
  CreateNew(dbconx, problema_);
  tipo_COD := C_COD_BINARY;
  self.nid := 0;
  s := ADN_HexStr;
  if dbconx.tipoServidor = CTS_MySQL then
    HexStrToBuff_(ADN[0], problema.nbytes_ADN, s)
  else
    PG_HexStrToBuff(ADN[0], problema.nbytes_ADN, s);

  f_VE := 0;
  f_VaR := 0;
  f_CVaR := 0;
  f_MIN := 0;
  f_MAX := 0;
  f_Objetivo := 0;
  cnt_Evaluaciones := 0;

end;

constructor TIndividuo.CreateFromRec(dbconx: TDBrosxCon; problema_: TProblema;
  r: TDataRecord);
var
  s: ansistring;
begin
  CreateNew(dbconx, problema_);
  tipo_COD := C_COD_BINARY;
  nid := r.GetByNameAsInt('nid');
  s := r.GetByNameAsString('adn');
  if dbconx.tipoServidor = CTS_MySQL then
    HexStrToBuff_(ADN[0], problema.nbytes_ADN, s)
  else
    PG_HexStrToBuff(ADN[0], problema.nbytes_ADN, s);
  f_VE := r.GetByNameAsFloat('f_VE');
  f_VaR := r.GetByNameAsFloat('f_VaR');
  f_CVaR := r.GetByNameAsFloat('f_CVaR');
  f_MIN := r.GetByNameAsFloat('f_MIN');
  f_MAX := r.GetByNameAsFloat('f_MAX');
  f_Objetivo := r.GetByNameAsFloat('f_Objetivo');
  cnt_Evaluaciones := r.GetByNameAsInt('cnt_evaluaciones');
  s := r.GetByNameAsString('detalle');
  f_histo.Ceros;
  if (dbconx.tipoServidor = CTS_MySQL) and (s <> '') then
    HexStrToBuff_(f_Histo.pv[0], length(f_Histo.pv) * sizeOf(NReal), s)
  else
  if s <> '\x' then
    PG_HexStrToBuff(f_Histo.pv[0], length(f_Histo.pv) * sizeOf(NReal), s);
end;

procedure TIndividuo.ComunicarResultado(numero_de_evaluacion: integer);
var
  r: TDataRecord;
  sql: string;
  xf_VE, xf_VaR, xf_CVaR, xf_MIN, xf_MAX, xf_Objetivo: NReal;
  xcnt_evaluaciones: integer;
  xf_Histo: TVectR;
  s: string;
  j: integer;

begin
  problema.LimpiarResto(self);

  if nid < 0 then
  begin
    nid := dbcon.sql_nextnid(problema.db_table);
    // es la primer evaluación de este individuo
    if dbcon.tipoServidor = CTS_MySQL then
      sql := 'INSERT INTO ' + problema.db_table +
        ' ( nid, adn, dtc, dtu, cnt_evaluaciones, f_VE, f_VaR, f_CVaR, f_MIN, f_MAX,' +
        'f_Objetivo, detalle ) VALUES (' + IntToStr(nid) + ', ''' +
        BuffToHexStr_(ADN[0], problema.nbytes_ADN) + ''', ' +
        ' now(), now(), 1, ' + '''' + FloatToStr(f_VE) + ''', ' +
        '''' + FloatToStr(f_VaR) + ''', ' + '''' + FloatToStr(f_CVaR) +
        ''', ' + '''' + FloatToStr(f_MIN) + ''', ' + '''' + FloatToStr(f_MAX) +
        ''', ' + '''' + FloatToStr(f_Objetivo) + ''', ' + '''' +
        BuffToHexStr_(f_Histo.pv[0], length(f_Histo.pv) * sizeOf(NReal)) + '''' + ' )'
    else
      sql := 'INSERT INTO ' + problema.db_table +
        ' ( nid, adn, dtc, dtu, cnt_evaluaciones, f_VE, f_VaR, f_CVaR, f_MIN, f_MAX,' +
        'f_Objetivo, detalle ) VALUES (' + IntToStr(nid) + ', ''' +
        PG_BuffToHexStr(ADN[0], problema.nbytes_ADN) + ''', ' +
        ' now(), now(), 1, ' + '''' + FloatToStr(f_VE) + ''', ' +
        '''' + FloatToStr(f_VaR) + ''', ' + '''' + FloatToStr(f_CVaR) +
        ''', ' + '''' + FloatToStr(f_MIN) + ''', ' + '''' + FloatToStr(f_MAX) +
        ''', ' + '''' + FloatToStr(f_Objetivo) + ''', ' + '''' +
        PG_BuffToHexStr(f_Histo.pv[0], length(f_Histo.pv) * sizeOf(NReal)) + '''' + ' )';
    dbcon.sql_exec(sql);
    (**   Seguramente alguien incertó el mismo individuo
    if not dbcon.sql_exec(sql) then
      raise Exception.Create('Imposible insertar PLAN, sql: ' + sql);
      ***)
  end
  else
  begin
    // como no es la primer evaluación, buscamos los datos para mezclar
    r := dbcon.sql_ficha(
      'SELECT cnt_evaluaciones, f_VE, f_VaR, f_CVaR, f_MIN, f_MAX, f_Objetivo, detalle FROM '
      +
      problema.db_table + ' WHERE nid = ' + IntToStr(nid) + ' LIMIT 1 ');


    xcnt_evaluaciones := r.GetByNameAsInt('cnt_evaluaciones');

    if (xcnt_evaluaciones + 1) = numero_de_evaluacion then
    begin
      xf_VE := r.GetByNameAsFloat('f_VE');
      xf_VaR := r.GetByNameAsFloat('f_VaR');
      xf_CVaR := r.GetByNameAsFloat('f_CVaR');
      xf_MIN := r.GetByNameAsFloat('f_MIN');
      xf_MAX := r.GetByNameAsFloat('f_MAX');
      xf_Objetivo := r.GetByNameAsFloat('f_Objetivo');
      xf_Histo := TVectR.Create_Init(self.f_histo.n);
      xf_Histo.Ceros;
      if xcnt_evaluaciones > 0 then
      begin
        s := r.GetByNameAsString('detalle');
        if dbcon.tipoServidor = CTS_MySQL then
          HexStrToBuff_(xf_Histo.pv[0], length(xf_Histo.pv) * sizeOf(NReal), s)
        else
          PG_HexStrToBuff(xf_Histo.pv[0], length(xf_Histo.pv) * sizeOf(NReal), s);
      end;
      // resumo ponderando todo por la cantidad de evaluaciones
      // esto hay que revisarlo, para el valor esperado es correcto
      // no me queda claro cual es el significado para el resto de los estimadores

      f_VE := (f_VE + xcnt_evaluaciones * xf_VE) / (xcnt_evaluaciones + 1);
      f_VaR := (f_VaR + xcnt_evaluaciones * xf_VaR) / (xcnt_evaluaciones + 1);
      f_CVaR := (f_CVaR + xcnt_evaluaciones * xf_CVaR) / (xcnt_evaluaciones + 1);
      f_MIN := min(f_MIN, xf_MIN);
      f_MAX := max(f_MAX, xf_MAX);
      for j := 1 to xf_Histo.n do
        f_Histo.pv[j] := (f_Histo.pv[j] + xcnt_evaluaciones * xf_Histo.pv[j]) /
          (xcnt_evaluaciones + 1);
      f_Objetivo := (f_Objetivo + xcnt_evaluaciones * xf_Objetivo) /
        (xcnt_evaluaciones + 1);
      xf_Histo.Free;

      if dbcon.tipoServidor = CTS_MySQL then
        sql := 'UPDATE ' + problema.db_table + ' SET ' + ' dtu = now()' +
          ', cnt_evaluaciones = ' + IntToStr(xcnt_evaluaciones + 1) +
          ', f_VE = ''' + FloatToStr(f_VE) + '''' + ', f_VaR = ''' +
          FloatToStr(f_VaR) + '''' + ', f_CVaR = ''' + FloatToStr(f_CVaR) +
          '''' + ', f_MIN = ''' + FloatToStr(f_MIN) + '''' + ', f_MAX = ''' +
          FloatToStr(f_MAX) + '''' + ', f_Objetivo = ''' + FloatToStr(f_Objetivo) +
          '''' + ', detalle = ''' + BuffToHexStr_(f_Histo.pv[0],
          length(f_Histo.pv) * sizeOf(NReal)) + ''''
          //        +', idnodo= '+IntToStr( idnodo )  ¿porqué estaría esto?
          + ' WHERE nid = ' + IntToStr(nid)
      else
        sql := 'UPDATE ' + problema.db_table + ' SET ' + ' dtu = now()' +
          ', cnt_evaluaciones = ' + IntToStr(xcnt_evaluaciones + 1) +
          ', f_VE = ''' + FloatToStr(f_VE) + '''' + ', f_VaR = ''' +
          FloatToStr(f_VaR) + '''' + ', f_CVaR = ''' + FloatToStr(f_CVaR) +
          '''' + ', f_MIN = ''' + FloatToStr(f_MIN) + '''' + ', f_MAX = ''' +
          FloatToStr(f_MAX) + '''' + ', f_Objetivo = ''' + FloatToStr(f_Objetivo) +
          '''' + ', detalle = ''' + PG_BuffToHexStr(f_Histo.pv[0],
          length(f_Histo.pv) * sizeOf(NReal)) + ''''
          //        +', idnodo= '+IntToStr( idnodo )  ¿porqué estaría esto?
          + ' WHERE nid = ' + IntToStr(nid);

      if not dbcon.sql_exec(sql) then
        raise Exception.Create('Imposible insertar PLAN, sql: ' + sql);
    end
    else
    begin
      writeln('Mala suerte, alguien nos ganó de mano');
    end;
    r.Free;
  end;
end;



// convierte el ADN a codificacion GRAY
procedure TIndividuo.toGray;
begin
  BinaryToGray(ADN);
  tipo_COD := 1;
end;

// convierte el ADN a codificación BINARY
procedure TIndividuo.toBinary;
begin
  GrayToBinary(ADN);
  tipo_COD := 0;
end;


function TIndividuo.ADN_AsBinaryStr: string;
var
  s: string;
begin
  s := AsBinaryStr(ADN);
  Result := s;
end;

destructor TIndividuo.destroy;
begin
  f_Histo.Free;
  setlength(adn, 0);
  XE.Free;
  XR.Free;
  inherited Destroy;
end;





(********** Métodos de TProblema ***********************)


constructor TProblema.Create(
  dbconx: TDBrosxCon;
  recProblema: TDataRecord;
  idEjecutor_: integer; tmp_rundir_: string);
var
  r: TDataRecord;
  ts: string;

begin
  inherited Create;
  dbcon := dbconx;
  Explorador_GA := nil;
  Explorador_EG:= nil;
  Explorador_MJ := nil;

  r := recProblema;
  nid_Problema := r.GetByNameAsInt('nid');
  idEjecutor := idEjecutor_;
  tmp_rundir := tmp_rundir_;

  DescriptoresE := nil;
  DescriptoresR := nil;

  estado_arranque := r.GetByNameAsInt('estado');

  NCronicasCronicasPorVez := r.GetByNameAsInt('N_CronicasPorVez');

  pe_var := 0.05; // impongo el valor por defecto.

  ro_VE := r.GetByNameAsFloat('ro_VE');
  ro_VaR := r.GetByNameAsFloat('ro_VaR');
  ro_CVaR := r.GetByNameAsFloat('ro_CVaR');

  N_DiscrtetizacionesHistograma := r.GetByNameAsInt('N_DiscretizacionesHistograma');
  semilla_madre := r.GetByNameAsInt('semilla_madre');
  ro_GA := r.GetByNameAsFloat('ro_GA');
  ro_EG := r.GetByNameAsFloat('ro_EG');
  ro_MJ := r.GetByNameAsFloat('ro_MJ');

  ro_GA_or_MJ := ro_GA + ro_MJ;

  GA_prob_premio_exito := r.GetByNameAsFloat('GA_prob_premio_exito');
  GA_prob_mutacion := r.GetByNameAsFloat('GA_prob_mutacion');

  ro_binary := r.GetByNameAsFloat('ro_binary');
  ro_gray := r.GetByNameAsFloat('ro_gray');
  ro_unary := r.GetByNameAsFloat('ro_unary');
  ro_fosil_agosto2011 := r.GetByNameAsFloat('ro_fosil_agosto2011');

  // si el identificador de ejcutor no viene
  if idEjecutor <= 0 then
    idEjecutor := dbcon.sql_nextnid('ofe_ejecutores' + IntToStr(NID_Problema));

  tipo := r.GetByNameAsInt('tipo');
  estado := r.GetByNameAsInt('estado');
  archiSala := r.GetByNameAsString('sala_simsee');
  archiSala:= ExtractFileName( archiSala );

  ts := r.GetByNameAsString('fecha_primer_etapa');
  if ts = '' then
    ts := '1900-01-01';
  fecha_primer_etapa := TFecha.Create_ISOStr(ts);
  dias_por_etapa := r.GetByNameAsInt('dias_por_etapa');
  n_etapas := r.GetByNameAsInt('n_etapas');

  if flg_BAJAR_SALA then
  begin
    writeln('******** bajo archivos ***********');
    u_updownload.bajarCarpeta(dbcon, 'ofe_carpetas', 'ofe_archivos', NID_Problema,
      tmp_rundir);
    writeln('******** fin copia de archivos ***********');
  end;
  (**
     y usar las funciones DefinirParametroReal y DefinirParametroEntero para poblar
     los descriptores E y R.
  **)
end;


destructor TProblema.destroy;
var
  k: integer;
begin
  if DescriptoresE <> nil then
  begin
    for k := 0 to high(DescriptoresE) do
      DescriptoresE[k].Free;
    setlength(DescriptoresE, 0);
  end;

  if DescriptoresR <> nil then
  begin
    for k := 0 to high(DescriptoresR) do
      DescriptoresR[k].Free;
    setlength(DescriptoresR, 0);
  end;

  if Explorador_GA <> nil then
   TExploradorGenetico( Explorador_GA ).destroy;

  if Explorador_EG <> nil then
     TExplorador_EG( Explorador_EG ).destroy;

  if Explorador_MJ <> nil then
    TExploradorMejorador( Explorador_MJ ).destroy;

  if fecha_primer_etapa <> nil then
    fecha_primer_etapa.Free;

  inherited destroy;
end;

procedure TProblema.DefinirParametroReal(kPar: integer; Nombre: string;
  xMin, xMax: NReal; nbits: integer);
begin
  DescriptoresR[kPar] := TDescriptorGenotipoReal.Create(Nombre, xMin, xMax, nbits);
end;

procedure TProblema.DefinirParametroEntero(kPar: integer; Nombre: string;
  kMin, kMax: integer);
begin
  DescriptoresE[kPar] := TDescriptorGenotipoEntero.Create(Nombre, kMin, kMax);
end;

procedure TProblema.CalcularLargosADN;
var
  kPar: integer;
  nb: integer;
  k: integer;
begin
  nb := 0;
  for kPar := 0 to high(DescriptoresR) do
    nb := nb + DescriptoresR[kPar].nbits;

  for kPar := 0 to high(DescriptoresE) do
    nb := nb + DescriptoresE[kPar].nbits;

  nwords_adn := ceil(nb / 16.0);
  nbytes_adn := 2 * nwords_adn;


  nbits_adn_Justo := nb;
  nbits_adn_Resto := 8 * nbytes_adn - nbits_adn_Justo;
  mascara_Resto := 0;
  for k := 1 to (16 - nbits_adn_Resto) do
  begin
    mascara_Resto := mascara_Resto * 2;
    mascara_Resto := mascara_Resto + 1;
  end;
end;


function TProblema.db_table: string;
begin
  Result := 'ofe_individuos_' + IntToStr(NID_Problema);
end;

function TProblema.CantidadDeIndividuos: integer;
var
  res: integer;
begin
  res := StrToInt(dbcon.sql_func('SELECT count(*) FROM ' + db_table+' WHERE cnt_evaluaciones > 0'));
  Result := res;
end;

function TProblema.CantidadDeIndividuos_conPiso(f_objetivo_piso: NReal): integer;
var
  res: integer;
begin
  res := StrToInt(dbcon.sql_func('SELECT count(*) FROM ' + db_table+ ' WHERE f_objetivo > '+FloatToStr( f_objetivo_piso * FACTOR_MARGEN_PISO )));
  Result := res;
end;

function TProblema.CantidadDeIndividuos_PorEvaluar: integer;
var
  res: integer;
begin
  res := StrToInt(dbcon.sql_func('SELECT count(*) FROM ' + db_table +
    ' WHERE cnt_evaluaciones < 0 '));
  Result := res;
end;


function TProblema.CantidadDeEvaluaciones: integer;
var
  res: integer;
begin
  res := StrToInt(dbcon.sql_func('SELECT sum( cnt_evaluaciones)  FROM ' + db_table));
  Result := res;
end;




function TProblema.LeerIndividuo(nid: integer): TIndividuo;
var
  ds: TResultadoQuery;
  r: TDataRecord;
  a: TIndividuo;
begin
  ds := dbcon.sql_query('SELECT * FROM ' + db_table + ' WHERE nid= ' +
    IntToStr(nid) + ' LIMIT 1');
  ds.first;
  r:=ds.getFilaActiva;
  if (r <> nil) then
  begin
    a := TIndividuo.CreateFromRec(dbcon, self, r);
  end
  else
    a := nil;
  ds.Free;
  Result := a;
end;


// Selecciona del Historial Global el primer individuo con cnt_evaluaciones < 0
// y le pone cnt_evaluaciones = 0
function TProblema.SeleccionarIndividuo_PorCalcular: TIndividuo;
var
  ds: TResultadoQuery;
  r: TDataRecord;
  a: TIndividuo;
  n: boolean;
begin
  a := nil;
  ds := dbcon.sql_query('SELECT * FROM ' + db_table +
    ' WHERE cnt_evaluaciones < 0 LIMIT 1');
  ds.first;
  r:=ds.getFilaActiva;
  if (r <> nil) then
  begin
    n := dbcon.sql_exec('UPDATE ' + db_table +
      ' SET cnt_evaluaciones = 0 WHERE nid =' + r.GetByNameAsString('nid') +
      ' AND cnt_evaluaciones < 0 ');
    if n then
    begin
      a := TIndividuo.CreateFromRec(dbcon, self, r);
      a.cnt_evaluaciones := 0;
    end;
  end;
  ds.Free;
  Result := a;
end;


function TProblema.SeleccionarMejores(nME, desde: integer): TIndividuos;
var
  ds: TResultadoQuery;
  r: TDataRecord;
  a: TIndividuo;
  res: TIndividuos;
  sql: string;
begin
  res := TIndividuos.Create;

  sql := 'SELECT * FROM ' + db_table +
    ' WHERE cnt_evaluaciones > 0 ORDER BY f_Objetivo LIMIT ' +
    IntToStr(nME) + ' OFFSET ' + IntToStr(desde);

  ds := dbcon.sql_query(sql);

  ds.First;

  while not ds.EOF do
  begin
    r:=ds.getFilaActiva;
    a := TIndividuo.CreateFromRec(dbcon, self, r);
    res.Add(a);
    ds.Next;
  end;
  ds.Free;
  Result := res;
end;

function TProblema.SeleccionarMejores_conPiso(nME, desde: integer;
  f_objetivo_piso: NReal): TIndividuos;
var
  ds: TResultadoQuery;
  r: TDataRecord;
  a: TIndividuo;
  res: TIndividuos;
  sql: string;
begin
  res := TIndividuos.Create;

  sql := 'SELECT * FROM ' + db_table +
    ' WHERE cnt_evaluaciones > 0 AND f_objetivo > '+ FloatToStr( f_objetivo_piso * FACTOR_MARGEN_PISO )+' ORDER BY f_Objetivo LIMIT ' +
    IntToStr(nME) + ' OFFSET ' + IntToStr(desde);

  ds := dbcon.sql_query(sql);

  ds.First;

  while not ds.EOF do
  begin
    r:=ds.getFilaActiva;
    a := TIndividuo.CreateFromRec(dbcon, self, r);
    res.Add(a);
    ds.Next;
  end;
  ds.Free;
  Result := res;
end;


function TProblema.Explorar: integer;
var
  r: double;
  cnt: integer;

{$IFDEF CONTROLAR_WALLTIME}
  dt_ini: TDateTime;
  horas_de_calculo: double;
  horas_por_eval: double;
{$ENDIF}
  flg_terminar: boolean;

begin
  cnt := 0;
  Explorador_GA := TExploradorGenetico.Create(dbcon, self, GA_prob_premio_exito,
    GA_prob_mutacion);
  {$IFDEF Explorador_EG}
  Explorador_EG:= TExplorador_EG.Create( dbcon, self );
  {$ELSE}
  Explorador_EG:= nil;
  {$ENDIF}
  Explorador_MJ := TExploradorMejorador.Create(dbcon, self, GA_prob_premio_exito);


{$IFDEF CONTROLAR_WALLTIME}
  dt_ini := now;
{$ENDIF}
  flg_terminar := False;

{$IFDEF DAMIAN_TESTING}
  while True do
{$ELSE}
    while (not Terminar) and (not flg_terminar) do
{$ENDIF}
    begin
      Inc(cnt);
      r := fuente.rnd;
      if CantidadDeIndividuos_PorEvaluar > 0 then
      begin
        TExploradorMejorador( Explorador_MJ ).DarPaso;
      end
      else if r <= ro_GA then
      begin
        TExploradorGenetico( Explorador_GA ).DarPaso;
      end
      else if ( r <= ro_GA_or_MJ ) or ( Explorador_EG = nil ) then
      begin
        TExploradorMejorador( Explorador_MJ ).DarPaso;
      end
      else
      begin
        TExplorador_EG( Explorador_EG ).DarPaso;
      end;
    {$IFDEF CONTROLAR_WALLTIME}
      horas_de_calculo := (now - dt_ini) * 24;
      horas_por_eval := horas_de_calculo / cnt;
      flg_terminar := (horas_de_calculo + horas_por_eval + 5.0 / 60.0) >= HORAS_WALLTIME;
      {$ENDIF}
  end;
  Result := cnt;
end;



function TProblema.Terminar: boolean;
var
  cnt_terminar: integer;
  s: string;

begin


  {$IFDEF NO_TERMINAR}
  result:= false;
  exit;
  {$ENDIF}

  s:= 'SELECT (' + IntToStr(estado_arranque) +
    ' < estado ) OR ( estado < 0 ) FROM ofe_problemas WHERE nid = ' + IntToStr(
    nid_Problema) + ' LIMIT 1 ';

  s := dbcon.sql_func( s );


  if not(  (s = '0') or (s = 'f')  ) then
  begin
    result:= true;
    exit;
  end;

  s := dbcon.sql_func('SELECT cnt FROM ofe_cnt_terminar LIMIT 1 ');
  cnt_terminar := StrToInt(s);
  if cnt_terminar > 0 then
  begin
    dbcon.sql_exec('UPDATE ofe_cnt_terminar SET cnt = cnt -1 ');
    result := True;
  end
  else
   result := false;
end;

// Calcula el Genotipo a partir de la cadena de ADN
function TProblema.decodificar_adn(var indi: TIndividuo): boolean; // XR, XE <- ADN
var
  kGenotipo: integer;
  jWord: integer;
  mask: word;
  cnt_ajustes: integer;
begin
  // si está en código gray primero lo paso a Binario
  if indi.tipo_COD = 1 then
    indi.toBinary;

  jWord := 0;
  mask := BIT_MENOS_SIGNIFICATIVO;
  cnt_ajustes := 0;
  for kGenotipo := 0 to high(DescriptoresR) do
    if not DescriptoresR[kGenotipo].decodificar_ADN(indi.XR.pv[kGenotipo + 1],
      indi.ADN, jWord, mask) then
      Inc(cnt_ajustes);
  for kGenotipo := 0 to high(DescriptoresE) do
    if not DescriptoresE[kGenotipo].decodificar_ADN(indi.XE.pv[kGenotipo + 1],
      indi.ADN, jWord, mask) then
      Inc(cnt_ajustes);
  Result := cnt_ajustes = 0;
end;

// calcula una cadena aleatoria
procedure TProblema.random_adn(var indi: TIndividuo);
var
  jWord: integer;
  mask: word;

begin
  (*
  jword:= random( nwords_adn );
  mask := 1 shl random( 16 );
  indi.ADN[jWord]:= mask;
  *)
  for jWord := 0 to nwords_adn - 1 do
  begin
    mask := fuente.randomIntRange(0, $10000 - 1); // random($10000);
    indi.ADN[jWord] := mask;
  end;
end;


procedure TProblema.LimpiarResto(var indi: TIndividuo);
begin
  indi.ADN[nwords_adn - 1] := indi.ADN[nwords_adn - 1] and mascara_Resto;
end;

// Calcula la cadena de ADN para el Genotipo
procedure TProblema.codificar_adn(var indi: TIndividuo); // ADN <- XR, XE
var
  kGenotipo: integer;
  jWord: integer;
  mask: word;
begin
  jWord := 0;
  mask := BIT_MENOS_SIGNIFICATIVO;
  for kGenotipo := 0 to high(DescriptoresR) do
    DescriptoresR[kGenotipo].codificar_ADN(indi.ADN, jWord, mask,
      indi.XR.pv[kGenotipo + 1]);
  for kGenotipo := 0 to high(DescriptoresE) do
    DescriptoresE[kGenotipo].codificar_ADN(indi.ADN, jWord, mask,
      indi.XE.pv[kGenotipo + 1]);
  LimpiarResto(indi);
end;



function TProblema.viable(var indi: TIndividuo): boolean;
begin
  Result := True;
  // comportamiento por defecto. Los problemas refinados tiene que sobreescribir esto.
end;

function TProblema.encajonar(var indi: TIndividuo): integer;
var
  cnt: integer;
  k: integer;
begin
  cnt:= 0;
  for k:= 1 to indi.XR.n do
    if DescriptoresR[k-1].encajonar( indi.XR.pv[k] ) <> 0 then inc( cnt );
  for k:= 1 to indi.XE.n do
    if DescriptoresE[k-1].encajonar( indi.XE.pv[k] ) <> 0 then inc( cnt );
  result:= cnt;
end;


procedure AlInicio;
var
  i1, i2: integer;
  rescod: word;
begin
  (*
  system.randomize;
  semilla_maestra:= trunc( 10000 * system.random );

  En el CLUSTER_UY no me funcionaba con el randomize capaz que lanza todo muy rápido
  y les da lo mismo a todos los de la misma máquina pero me repetía los individuos por eso
  lo cambio a que sea una semilla calculada como Ejecutor + nidProblema.
  *)
   if paramCount > 1 then
   begin
     Val( paramStr(1), i1,  rescod );
     if rescod = 0 then
     begin
       val( paramStr( 2 ), i2, rescod );
       if rescod = 0 then
         semilla_maestra:= i1+i2;
     end;
     writeln( 'uoddface AlInicio, semilla_maestra: ', semilla_maestra );
   end
   else
     rescod:= 1;

  if rescod <> 0 then
  begin
    system.randomize;
    semilla_maestra:= trunc( 10000 * system.random );
  end;

  fuente := TMadreUniforme.Create( semilla_maestra  );
  flg_BAJAR_SALA := True;
end;

initialization
  AlInicio;
finalization
  fuente.Free;
end.
