unit uoddface_nn1;

{dv@20180712
Definición del problema de entrenamiendo de redes neuronales.
Se da un archivo de seriestemporales de entrada y salida, tamaño
de la red (neuronas por capa y cantidad de capas, las capas de entrada y
salida deben tener la misma dimensión que los vectores de entrada y salida)
}


{$mode delphi}

interface

uses
  Classes, SysUtils,
  xmatdefs,
  matreal,
  uoddface,
  uConstantesSimSEE,
  uauxiliares,
  uDBConBase,
  uDataSetGenerico,
  useriestemporales,
  uneuronas,
  utipos_xcf,
  urosx;

type

  { TEntrenarRedNeuronal_Problema }

  TEntrenarRedNeuronal_Problema = class(TProblema)
    cerebro: TCerebro;

    XCF: TDAOfRecXCF; // relacion a explicar
    nidIndividuo, cntEvaluacionesIndividuo: integer;

    // para dbg individuo que esta evaluando
    NMuestras, NEntradas, NSalidas, NCapas: integer;

    flgSaturarSalidas: boolean;
    dimensionesCapasIntermedias: TDAofNInt;

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

    class function CreateFromDB(dbconx: TDBrosxCon; nid_problema: integer;
      idEjecutor_: integer; tmp_rundir_: string): TEntrenarRedNeuronal_Problema;

    function evaluar_(Individuo: TIndividuo; SemillaAleatoria: integer): boolean;
      override;

    function viable(var indi: TIndividuo): boolean; override;

    procedure dimensionarCapasIntermedias( DefCapasStr: String );

    function evaluarCerebroCompleto( dumpEval: boolean ): NReal; // error cuadrático medio

    // crea un cerebro con nidIndividuo (si es 1 es el mejor) y lo evalúa
    procedure WriteIndividuo(aNidIndividuo: integer; archi: string);
  end;



var
  dirBaseResultadosDbg: string;

const
  NBITSPARAMS = 16;
  RANGOPARAMS = 200;


implementation


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

var
  NParametros,
  kMuestra, kEntrada, kSalida: integer;
  aRec: TRecXCF;
  archiSeries: string;
  series: TSeriesDeDatos;
  NPuntosValidos: integer;
  k: integer;

begin
  //carga los datos del problema y descarga la serie o sala asociada
  inherited Create(dbconx, recProblema, idEjecutor_, tmp_rundir_);

  archiSeries := tmp_rundir + DirectorySeparator + archiSala;

  series := TSeriesDeDatos.CreateFromArchi(archiSeries);

  NMuestras := series.NPuntos;
  setLength(XCF, NMuestras);

  NEntradas := series.NSeriesX;
  NSalidas := series.NSeriesY;

  NPuntosValidos:= 0;
  for kMuestra := 0 to NMuestras - 1 do
  begin
    aRec := TRecXCF.Create(NEntradas, NSalidas);
    for kEntrada := 0 to NEntradas - 1 do
      aRec.X.pon_e(kEntrada + 1, series.seriesX[kEntrada].e(kMuestra + 1));
    for kSalida := 0 to NSalidas - 1 do
      aRec.Y.pon_e(kSalida + 1, series.seriesY[kSalida].e(kMuestra + 1));

    if not aRec.filtrarMenorQue( -11111 ) then
    begin
      XCF[NPuntosValidos] := aRec;
      inc( NPuntosValidos );
    end
    else
      aRec.Free;
  end;

  setLength(XCF, NPuntosValidos );
  NMuestras:= NPuntosValidos;

  dimensionarCapasIntermedias( series.Comentario );
  series.Free;

  cerebro := TCerebro.Create(NEntradas, dimensionesCapasIntermedias, flgSaturarSalidas);

  NCapas := Length(cerebro.capas);

  NParametros := Cerebro.DimParametros;

  setlength(DescriptoresE, 0);
  setlength(DescriptoresR, NParametros);


  // El bias y el ro de las neuronas de la capa de entrada queda FIJO y está dado
  // solo por las muestras.
  cerebro.EscalarEntradas( XCF );

  for k:= 0 to High( DescriptoresR )  do
     DefinirParametroReal( k, 'kp_' + IntToStr(k), -RANGOPARAMS, RANGOPARAMS, NBITSPARAMS);

  CalcularLargosADN;
end;

class function TEntrenarRedNeuronal_Problema.CreateFromDB(dbconx: TDBrosxCon;
  nid_problema: integer; idEjecutor_: integer;
  tmp_rundir_: string): TEntrenarRedNeuronal_Problema;
var
  ds: TResultadoQuery;
  r: TDataRecord;
  ap: TEntrenarRedNeuronal_Problema;
begin
  ds := dbconx.sql_query('SELECT * FROM ofe_problemas WHERE nid = ' +
    IntToStr(nid_problema) + ' LIMIT 1 ');//carga los datos del problema desde la base
  ds.First;
  r := ds.getFilaActiva;
  if r <> nil then
    ap := TEntrenarRedNeuronal_Problema.Create(dbconx, r, idEjecutor_, tmp_rundir_)
  else
    ap := nil;
  ds.Free;
  Result := ap;
end;

function nextpal_sep(var r: string; sep: string): string;
var
  res: string;
  i: integer;
begin
  r := trim(r);
  i := pos(sep, r);
  if i > 0 then
  begin
    res := trim(copy(r, 1, i - 1));
    Delete(r, 1, i);
  end
  else
  begin
    res := r;
    r := '';
  end;
  Result := res;
end;


function nextpal_tab(var r: string): string;
begin
  Result := nextpal_sep(r, #9);
end;


procedure readln_vect(var f: textfile; var v: TDAOfNreal; N: integer);
var
  r: string;
  pal: string;
  k: integer;
begin
  setlength(v, N);
  system.readln(f, r);
  pal := nextpal_tab(r); // caption
  for k := 0 to high(v) do
  begin
    pal := nextpal_tab(r);
    v[k] := StrToFloat(pal);
  end;
end;



procedure TEntrenarRedNeuronal_Problema.dimensionarCapasIntermedias(
  DefCapasStr: String);
var
  pal: string;
begin

  // comentario debe ser de la forma {n2,...,nN-1}S, donde S=0 no satura salidas

  if not getPalHastaSep( pal, DefCapasStr, '{' ) then
  begin
    SetLength(dimensionesCapasIntermedias, 1);
    dimensionesCapasIntermedias[0] := NSalidas;
    exit;
  end;


  if not getPalHastaSep( pal, DefCapasStr, '}' ) then
  begin
    SetLength(dimensionesCapasIntermedias, 1);
    dimensionesCapasIntermedias[0] := NSalidas;
    exit;
  end;

  dimensionesCapasIntermedias:= StrToDAOfNInt( pal, ',' );
  setlength( dimensionesCapasIntermedias, length( dimensionesCapasIntermedias )+1 );
  dimensionesCapasIntermedias[ high( dimensionesCapasIntermedias ) ]:= NSalidas;


  if ( DefCapasStr = '' ) or ( DefCapasStr[1] = '0' ) then
    flgSaturarSalidas := False
  else
    flgSaturarSalidas := True;

end;


function TEntrenarRedNeuronal_Problema.evaluar_(Individuo: TIndividuo;
  SemillaAleatoria: integer): boolean;
var
  errorCMCerebro: Nreal;
begin
  nidIndividuo := Individuo.nid;
  cntEvaluacionesIndividuo := Individuo.cnt_evaluaciones;

  errorCMCerebro := evaluarCerebroCompleto( false );

  writeln( errorCMCerebro );

  Individuo.f_VE := errorCMCerebro;
  Individuo.f_VaR := errorCMCerebro;
  Individuo.f_CVaR := errorCMCerebro;
  Individuo.f_MIN := errorCMCerebro;
  Individuo.f_MAX := errorCMCerebro;

  Individuo.f_Objetivo := ro_VE * Individuo.f_VE + ro_VaR * Individuo.f_VaR +
    ro_CVaR * Individuo.f_CVaR;

  Result := True;
end;

function TEntrenarRedNeuronal_Problema.viable(var indi: TIndividuo): boolean;
begin
  cerebro.SetParametros(indi.XR); // cerebro <--- XR

  cerebro.Sort; // ordena cerebro
  // Ordeno el cerebro para evitar cerebros equivalentes por conmutaciones de neuronas

  cerebro.GetParametros(indi.XR); // XR <---- cerebro
  codificar_adn(indi); // ADN <-- XR
  Result := True;
end;


function TEntrenarRedNeuronal_Problema.evaluarCerebroCompleto(dumpEval: boolean
  ): NReal;
var
  kMuestra: integer;
  aRec: TRecXCF;
  e: TVectR;
  ECM: NReal;
  f: textfile;
  y: TVectR;

begin
  e := TVectR.Create_Init(XCF[0].Y.n);
  ECM := 0;
  if dumpEval then
  begin
   assignfile( f, 'dumpeval.xlt' );
   rewrite( f );
  end;
  Y:= TVectR.Create_init( cerebro.NSalidas );
  for kMuestra := 0 to High(XCF) do
  begin
    aRec := XCF[kMuestra];
    cerebro.SetEntradas(aRec.X);
    cerebro.evaluar;
    ECM := ECM + cerebro.calc_err2(e, aRec.Y);
    if dumpEval then
    begin
      cerebro.GetSalidas( Y );
       writeln( f, aRec.serialize(#9), #9, y.serialize(#9) );
    end;
  end;
  e.Free;
  y.free;
  ECM := ECM / length( XCF );
  if dumpEval then
  begin
     writeln( f, 'ECM:', #9, ECM );
     closefile( f );
  end;
  Result := ECM;
end;


                (*
function TEntrenarRedNeuronal_Problema.evaluarCerebroCompleto(
  out CFAprox, CFReal, errores, errores2: TDAOfVectR; imprimirArchivo: boolean): NReal;
var
  kMuestra, kEntrada, kSalida: integer;
  aRec: TRecXCF;
  ECM: NReal; // error cuadratico medio total
  entradaNoValida: boolean;
  sql: string;
  ds: IDataSet;

  seriesDbg: TSeriesDeDatos;
  entradasDBG: TDAOfVectR;
begin

  // preparo memoria
  SetLength(CFAprox, NSalidas);
  SetLength(CFReal, NSalidas);
  SetLength(errores, NSalidas);
  SetLength(errores2, NSalidas);
  SetLength(entradasDBG, NEntradas);

  for kSalida := 0 to NSalidas - 1 do
  begin
    CFAprox[kSalida] := TVectR.Create_InitVal(NMuestras, 0);
    CFReal[kSalida] := TVectR.Create_InitVal(NMuestras, 0);
    errores[kSalida] := TVectR.Create_InitVal(NMuestras, 0);
    errores2[kSalida] := TVectR.Create_InitVal(NMuestras, 0);
  end;

  for kEntrada := 0 to NEntradas - 1 do
    entradasDBG[kEntrada] := TVectR.Create_InitVal(NMuestras, 0);

  // evalúo todo el cerebro para los valores de los coeficientes y bias
  // y calculo el error

  {$IFDEF NEURONAS_DBG}
  AssignFile(dbg_File, dirBaseResultadosDbg + 'neuronas.xlt');
  Rewrite(dbg_File);
  {$ENDIF}

  for kMuestra := 0 to NMuestras - 1 do
  begin
    aRec := XCF[kMuestra];

    for kEntrada := 0 to NEntradas - 1 do
      entradasDBG[kEntrada].pon_e(kMuestra + 1, aRec.X.e(kEntrada + 1));

    // Si alguna de las entradas es no valida no contamos para el error
    entradaNoValida := not PuntoXValido(aRec);

    if entradaNoValida then
      Continue;

    cerebro.SetEntradas(aRec.X);
    cerebro.evaluar;

    for kSalida := 0 to NSalidas - 1 do
    begin
      if not PuntoYValido(aRec) then
      begin
        // Si la salida "real" es no valida entonces invalido todo
        CFAprox[kSalida].pon_e(kMuestra + 1, DatoInvalido);
        CFReal[kSalida].pon_e(kMuestra + 1, DatoInvalido);
        errores[kSalida].pon_e(kMuestra + 1, DatoInvalido);//errores
        errores2[kSalida].pon_e(kMuestra + 1, DatoInvalido);
        //errores al cuadrado
      end
      else
      begin
        // Si no, guardo los resultados
        CFAprox[kSalida].pon_e(kMuestra + 1, cerebro.GetSalida(kSalida));
        if flgTruncarSalida then
        begin
          if cerebro.GetSalida(kSalida) > 1 then
            CFAprox[kSalida].pon_e(kMuestra + 1, 1);
          if cerebro.GetSalida(kSalida) < 0 then
            CFAprox[kSalida].pon_e(kMuestra + 1, 0);
        end;

        CFReal[kSalida].pon_e(kMuestra + 1, aRec.Y.e(kSalida + 1));
        errores[kSalida].pon_e(kMuestra + 1, CFAprox[kSalida].e(kMuestra + 1) -
          CFReal[kSalida].e(kMuestra + 1));//errores
        errores2[kSalida].pon_e(kMuestra + 1, sqr(errores[kSalida].e(kMuestra + 1)) *
          //(sqr(CFReal[kSalida].e(kMuestra + 1) - 0.75) + 0.4375));
          1);
        //errores al cuadrado
      end;
    end;
  end;

{$IFDEF NEURONAS_DBG}
  CloseFile(dbg_File);
{$ENDIF}

  ECM := 0;

  for kSalida := 0 to NSalidas - 1 do
    ECM := ECM + promedioSinNoValidos(errores2[kSalida]);

  ECM := ECM / NSalidas;

  if imprimirArchivo then
  begin
    // imprimo algunos resultados para ver qué onda
    seriesDbg := TSeriesDeDatos.CreateVacia(0, 1, NMuestras);

    for kEntrada := 0 to NEntradas - 1 do
      seriesDbg.AddSerie('Entrada_' + IntToStr(kEntrada), entradasDBG[kEntrada]);

    for kSalida := 0 to NSalidas - 1 do
    begin
      seriesDbg.AddSerie('CF_arpox_' + IntToStr(kSalida), CFAprox[kSalida]);
      seriesDbg.AddSerie('CF_real_' + IntToStr(kSalida), CFReal[kSalida]);
      seriesDbg.AddSerie('error_' + IntToStr(kSalida), errores[kSalida]);
      seriesDbg.AddSerie('error_cuadratico_' + IntToStr(kSalida), errores2[kSalida]);
    end;

    // Para ver que nid le corresponderia al nuevo individuo
    if nidIndividuo = -1 then
    begin
      //sql:='Select nextval(pg_get_serial_sequence(''ofe_individuos_167'', ''nid'')) as nuevo_nid';
      sql := 'SELECT last_value FROM public.ofe_individuos_' +
        IntToStr(nid_Problema) + '_nid_seq';
      ds := dbcon.Query(sql);
      nidIndividuo := ds.FieldByName('last_value').AsInteger() + 1;
      cntEvaluacionesIndividuo := 1;
    end
    else
    begin
      sql := 'Select cnt_evaluaciones FROM ofe_individuos_' +
        IntToStr(nid_Problema) + ' WHERE nid = ' + IntToStr(nidIndividuo);
      ds := dbcon.Query(sql);
      cntEvaluacionesIndividuo := ds.FieldByName('cnt_evaluaciones').AsInteger() + 1;
    end;

    if imprimirArchivo then
      seriesDbg.WriteToArchi(dirBaseResultadosDbg + 'resultadoCerebro_' +
        IntToStr(nidIndividuo) + '_' + IntToStr(cntEvaluacionesIndividuo) +
        '_' + '.xlt');
  end;


  Result := ECM;
end;

function TEntrenarRedNeuronal_Problema.rangoSigmoide(vector: TVectR): NReal;
var
  kMuestra: integer;
  maxAbsVal: NReal;
  roMax: NReal;
begin

  // quiero asegurarme que ro por el máximo valor absoluto del vector no se pase de +/- RANGOPARAMS
  maxAbsVal := 0;

  for kMuestra := 1 to vector.n do
  begin
    if (not EsValido(vector.e(kMuestra))) then
      Continue
    else
    if abs(vector.e(kMuestra)) > maxAbsVal then
      maxAbsVal := vector.e(kMuestra);
  end;

  roMax := RANGOPARAMS / maxAbsVal;

  Result := roMax;

end;
*)

procedure TEntrenarRedNeuronal_Problema.WriteIndividuo(
  aNidIndividuo: integer; archi: string );

var
  sql, ADN_str: string;
  ds: IDataset;
  Individuo: TIndividuo;
  CFAprox, CFReal, errores, errores2: TDAOfVectR;
begin

  sql := 'SELECT *  FROM  ofe_individuos_' + IntToStr(nid_Problema);

  if aNidIndividuo = 1 then
    sql := sql + ' ORDER BY f_objetivo LIMIT 1'
  else
    sql := sql + ' WHERE nid = ' + IntToStr(aNidIndividuo);

  ds := dbcon.Query(sql);

  ADN_str := ds.FieldByName('adn').AsString;
  self.nidIndividuo := ds.FieldByName('nid').AsInteger();
  cntEvaluacionesIndividuo := ds.FieldByName('cnt_evaluaciones').AsInteger();

  Individuo := TIndividuo.CreateFromADN_HexStr(dbcon, self, ADN_str);

  decodificar_adn(Individuo); // XR <-- ADN (el CreateFromADN_HexStr no lo hace)

  cerebro.SetParametros(Individuo.XR); // cerebro <--- XR

  cerebro.WriteToArchi( archi );

  writeln( 'err2: ', evaluarCerebroCompleto( true ) );
  Individuo.Free;
  cerebro.Free;
  ds.Free;

end;


(*
procedure TEntrenarRedNeuronal_Problema.cambiarSeries(xSeries: TSeriesDeDatos);
var
  kMuestra, kEntrada, kSalida: integer;
  aRec: TRecXCF;
begin
  series := xSeries;

  NMuestras := series.NPuntos;
  setLength(XCF, NMuestras);

  if ((NEntradas <> series.NSeriesX) or (NSalidas <> series.NSeriesY)) then
    raise Exception.Create('La cantidad de entradas y salidas entre la serie ' +
      'de ajuste y la de evaluacion no coincide');

  for kMuestra := 0 to NMuestras - 1 do
  begin
    aRec := TRecXCF.Create(NEntradas, NSalidas);
    for kEntrada := 0 to NEntradas - 1 do
      aRec.X.pon_e(kEntrada + 1, series.seriesX[kEntrada].e(kMuestra + 1));
    for kSalida := 0 to NSalidas - 1 do
      aRec.Y.pon_e(kSalida + 1, series.seriesY[kSalida].e(kMuestra + 1));
    XCF[kMuestra] := aRec;
  end;
end;

  *)
initialization

  {$IFDEF WINDOWS}
  dirBaseResultadosDbg := 'C:\SimSEE\bin\';
  {$ELSE}
  dirBaseResultadosDbg := GetEnvironmentVariable('HOME') + '/simsee/fpcbin/';
  writeln(dirBaseResultadosDbg);
  {$ENDIF}


finalization


end.
