unit uadministradordeestadoscerebro;

{$mode delphi}
{$DEFINE PRUEBA_XC}



interface

uses
  Classes, SysUtils, uEstados, uauxiliares,
//  matreal,  ucosa, MatEnt, uodt_types,
  ufechas,
  xmatdefs,
  uneuronas;

type


  { TAdminEstadosCerebro }

  TAdminEstadosCerebro = class(TAdminEstados)
// Información del manto CF(X) en base a hiperplanos por paso
    Cerebros:TDAOfCerebros; // Va indexado de 1 a N y la posición 0 no se usa.
    versionArchi:integer;

    constructor Create(nVarsContinuas, nVarsDiscretas, nPasosT: integer;
      xCntNeuronasPorCapa: TDAofNInt;
      tipoSaturacionPenultimaCapa, tipoSaturacionSalida: TTipoSaturacion );overload;

    constructor Create(nVarsContinuas, nVarsDiscretas, nPasosT: integer;
      xCntNeuronasPorCapa: TDAofNInt;
      tiposSaturacionCapa: TDaOfTipoSaturacion );overload;


    procedure CrearElEspacioTiempo(fechaIni, fechaFin: TFecha; horasDelPaso: NReal;
      const costoFuturo: pointer; deterministico: boolean; fActPaso: NReal); override;


    function costoContinuo( kPuntoT: integer ): NReal; override;

    procedure devxr_continuo(irx: integer; kpuntoT: integer; out dCdx_Inc,
      dCdx_Dec: NReal; out resCod: integer; out xrpos: NReal); override;


    function deltaCosto_vxr_continuo(irx: integer; kpuntoT: integer;
      delta_xr: NReal): NReal; override;

    procedure ActualizarEstadoGlobal(kPaso: integer); override;


    // carga un CF desde la posición actual del archivo f  (formato binario)
    procedure ReadCuerpoFromBin( f: TStream ); override;
    procedure ReadCuerpoFromXLT(f:TStream); override;

    // guarda CF desde la posición actual del archivo f (formato binario)
    procedure WriteCuerpoToBin( f: TStream; flg_compress: integer = -1 ); override;
    procedure WriteCuerpoToXLT(f:TStream); override;

    destructor destroy; override;
    procedure FreeParasito; override;

    function CreateParasito: TAdminEstados; override;

    procedure ClonarInfoadParasito( res: TAdminEstados); override;

    function Primer_kPuntoT: integer; override;
    function Ultimo_kPuntoT: integer; override;

    // fija el bias y ro de las entradas para que a los efectos
    // de las redes las mismas varian de -1  a 1
    procedure EscalarEntradas;

    procedure KickRandom( paso: NReal );

 private
   xCntNeuronasPorCapa: TDAofNInt;
   tipoSaturacionPenultimaCapa, tipoSaturacionSalida: TTipoSaturacion;

   tiposSaturacionCapa: TDAOfTipoSaturacion;

   // valores en el último punto calculado.
   CF: NReal; // salida del cerebro
   dCFdxrxd: TDAOfNReal; // gradiente respecto de las entradas

   function getCerebroFromDT(dt: TDateTime): TCerebro;

  end;


procedure AlInicio;
procedure AlFinal;


implementation

procedure AlInicio;
begin
  RegistrarClase_AdminEstados( TAdminEstadosCerebro );
end;

procedure AlFinal;
begin

end;

{ TAdminEstadosCerebro }

constructor TAdminEstadosCerebro.Create(nVarsContinuas, nVarsDiscretas,
  nPasosT: integer; xCntNeuronasPorCapa: TDAofNInt;
  tipoSaturacionPenultimaCapa, tipoSaturacionSalida: TTipoSaturacion);
begin
  inherited Create(nVarsContinuas, nVarsDiscretas, nPasosT);
  self.xCntNeuronasPorCapa:= xCntNeuronasPorCapa;
  self.tipoSaturacionPenultimaCapa:= tipoSaturacionPenultimaCapa;
  self.tipoSaturacionSalida:= tipoSaturacionSalida;
  setlength( dCFdxrxd, nVarsContinuas + nVarsDiscretas );
end;

constructor TAdminEstadosCerebro.Create(nVarsContinuas, nVarsDiscretas,
  nPasosT: integer; xCntNeuronasPorCapa: TDAofNInt;
  tiposSaturacionCapa: TDaOfTipoSaturacion);
begin
  inherited Create(nVarsContinuas, nVarsDiscretas, nPasosT);
  self.xCntNeuronasPorCapa:= xCntNeuronasPorCapa;
  self.tipoSaturacionPenultimaCapa:= tiposSaturacionCapa[Length(tiposSaturacionCapa)-3];
  self.tipoSaturacionSalida:= tiposSaturacionCapa[Length(tiposSaturacionCapa)-2];
  self.tiposSaturacionCapa:=tiposSaturacionCapa;
  setlength( dCFdxrxd, nVarsContinuas + nVarsDiscretas );
end;

procedure TAdminEstadosCerebro.CrearElEspacioTiempo(fechaIni,
  fechaFin: TFecha; horasDelPaso: NReal; const costoFuturo: pointer;
  deterministico: boolean; fActPaso: NReal);
var
  kPasoT, nPasosT: integer;

begin
  self.FechaIni := TFecha.Create_Clone(FechaIni);
  self.fechaFin := TFecha.Create_Clone(fechaFin);
  self.horasDelPaso := horasDelPaso;
  self.deterministico := deterministico;
  self.fActPaso:= fActPaso;

  SetLength( xr, nVarsContinuas );
  SetLength( xd, nVarsDiscretas );

  setLength( dCFdxrxd, nVarsContinuas + nVarsDiscretas );

  ControladorDeterministico := nil;
  if not deterministico then
  begin
    if costoFuturo <> nil then
      Cerebros:= TDAOfCerebros( costoFuturo )
    else
    begin
      nPasosT:= trunc( ( FechaFin.dt - FechaIni.dt + dt_100ms) * 24.0 / horasDelPaso );
      nPuntosT:=nPasosT + 2;
      setlength( Cerebros, nPuntosT);
      for kPasoT:= 1 to high( Cerebros ) do
        Cerebros[kPasoT]:=
         TCerebro.Create( nVarsContinuas + nVarsDiscretas, xCntNeuronasPorCapa,
           tiposSaturacionCapa);
    end;
  end
  else
    raise Exception.Create(
        'TAdminEstadosMultiPlnao.ClearElEspacioTiempo ... deterministico   no es posible'
        );
end;




procedure TAdminEstadosCerebro.ReadCuerpoFromBin(f: TStream);
var
  k: integer;
begin
  brwf( f, k , false );
  setlength( Cerebros, k );
  for k:= 1 to high( Cerebros ) do
    Cerebros[k]:= TCerebro.CreateFromBin( f );
  brwf_Cursor( f, false );
end;

procedure TAdminEstadosCerebro.WriteCuerpoToBin(f: TStream; flg_compress: integer = -1);
var
  k: integer;
begin
  k:= length( Cerebros );
  brwf( f, k , true );
  for k:= 1 to high( Cerebros ) do
    Cerebros[k].WriteToBin( f );
  brwf_Cursor( f, true );
end;

procedure TAdminEstadosCerebro.ClonarInfoadParasito(res: TAdminEstados);
var
  resx: TAdminEstadosCerebro;
begin
  resx:= res as TAdminEstadosCerebro;
  resx.Cerebros:= Cerebros;
  resx.xCntNeuronasPorCapa:= xCntNeuronasPorCapa;
  resx.tipoSaturacionPenultimaCapa:= tipoSaturacionPenultimaCapa;
  resx.tipoSaturacionSalida:= tipoSaturacionSalida;
  resx.tiposSaturacionCapa:= tiposSaturacionCapa;
end;

function TAdminEstadosCerebro.Primer_kPuntoT: integer;
begin
  result:= 1;
end;

function TAdminEstadosCerebro.Ultimo_kPuntoT: integer;
begin
  result:= High( cerebros  );
end;

procedure TAdminEstadosCerebro.EscalarEntradas;
var
  k, i: integer;
  aNeurona: TNeuronaEntrada;
  aCerebro: TCerebro;
  dx: NReal;
  xmed: NReal;
begin
  for k:= 1 to high( Cerebros ) do
  begin
    aCerebro:= Cerebros[k];
    for i:= 0 to high( self.xr_def ) do
    begin
      aNeurona:= aCerebro.CapaEntrada.Neuronas[i] as TNeuronaEntrada;
      xmed:= xr_def[i].xmed;
      dx:=  xr_def[i].deltaval / 2.0;
      if dx < 1e-10 then dx:= 1.0;
      // y = ( x - xmed ) / dx
      aNeurona.bias:= - xmed / dx;
      aNeurona.ro:= 1/ dx;
    end;
  end;
end;

procedure TAdminEstadosCerebro.KickRandom(paso: NReal);
var
 k: integer;
begin
  for k:= 1 to high( Cerebros ) do
    Cerebros[ k ].RandomInit( paso );

end;

function TAdminEstadosCerebro.costoContinuo(kPuntoT: integer): NReal;
var
  aCerebro: TCerebro;
  kOffset: integer;
  aVal: NReal;
  k: integer;
begin
  aCerebro:= Cerebros[kPuntoT];

  for k:= 0 to high( xr ) do
    aCerebro.SetEntrada(k, xr[k] );

  kOffset:= length( xr );
  for k:= 0 to high( xd ) do
    aCerebro.SetEntrada(kOffset+k, xd[k] );

  aCerebro.evaluar;
  aVal:= aCerebro.GetSalida(0);

  Result:= aVal;
end;


function TAdminEstadosCerebro.getCerebroFromDT(dt: TDateTime
  ): TCerebro;
var
  kCerebro:Integer;
begin
  kCerebro:=getkPuntoFromDT(dt);
  if kCerebro >= 0 then
    Result:=Cerebros[kCerebro]
  else
    Result:=nil;
end;


procedure TAdminEstadosCerebro.WriteCuerpoToXLT(f: TStream);
var
  kPaso, kVA, kSaturcion: Integer;
begin

  WritelnS( f, 'dt_Ini' +  #9 + DateTimeToIsoStr(fechaIni.dt) +  #9 );
  WritelnS( f, 'Horas_del_paso' +  #9 + FloatToStr(horasDelPaso) +  #9 );


  WritelnS(f, DAOfNIntToStr( xCntNeuronasPorCapa, #9 ));

  {$IFDEF PRUEBA_XC}
  for kSaturcion:=0 to Length(tiposSaturacionCapa) - 1 do
    WRitelnS(f, IntToStr( Ord( tiposSaturacionCapa[kSaturcion] ) ));
  {$ELSE}
  WRitelnS(f, IntToStr( Ord( tipoSaturacionPenultimaCapa ) ));
  WRitelnS(f, IntToStr( Ord( tipoSaturacionSalida ) ));
  {$ENDIF}

  for kPaso:=1 to High( Cerebros ) do
      Cerebros[kPaso].WriteToXLT(f);

end;

procedure TAdminEstadosCerebro.ReadCuerpoFromXLT(f: TStream);
var
  r: string;
  kPaso, kSaturcion: Integer;
begin
  setlength( cerebros, self.nPuntosT); // porque está indexado desde 1

  readlnS(f,r);
  NextStr(r);  //dt_Ini
  fechaIni:= TFecha.Create_Dt(StrToDateTime(NextStr(r)));
  readlnS(f,r);
  NextStr(r);  //Horas del paso
  horasDelPaso:=NextFloat(r);

  ReadlnS( f, r );
  xCntNeuronasPorCapa:= StrToDAOfNInt( r, #9 );


  {$IFDEF PRUEBA_XC}
  SetLength(tiposSaturacionCapa,Length(xCntNeuronasPorCapa));
  for kSaturcion:=0 to Length(tiposSaturacionCapa) - 1 do
  begin
    ReadlnS( f, r );
    tiposSaturacionCapa[kSaturcion]:= TTipoSaturacion( strToInt( r ) );
  end;
    //tiposSaturacionCapa:= TTipoSaturacion( strToInt( r ) );
  {$ELSE}
  ReadlnS( f, r );
  tipoSaturacionPenultimaCapa:= TTipoSaturacion( strToInt( r ) );
  ReadlnS( f, r );
  tipoSaturacionSalida:= TTipoSaturacion( strToInt( r ) );
  {$ENDIF}

  for kPaso:=1 to High( Cerebros ) do
    Cerebros[kPaso]:= TCerebro.CreateFromXLT(f);

  setlength( dCFdxrxd, nVarsContinuas + nVarsDiscretas );

end;



destructor TAdminEstadosCerebro.destroy;
var
  kCerebro: Integer;
begin
  setLength( dCFdxrxd, 0);

  if Cerebros <> nil then
  begin
    for kCerebro:=1 to high( Cerebros )  do
        Cerebros[kCerebro].Free;
    SetLength( Cerebros, 0);
  end;

  if xCntNeuronasPorCapa <> nil then
    setlength( xCntNeuronasPorCapa, 0 );

  if tiposSaturacionCapa <> nil then
    setlength( tiposSaturacionCapa, 0 );

  inherited destroy;
end;

procedure TAdminEstadosCerebro.FreeParasito;
begin
  Cerebros:= nil;
  xCntNeuronasPorCapa:= nil;
  tiposSaturacionCapa:= nil;
  inherited FreeParasito;
end;

function TAdminEstadosCerebro.CreateParasito: TAdminEstados;
var
  res: TAdminEstadosCerebro;
begin
  res:= TAdminEstadosCerebro.Create(nVarsContinuas, nVarsDiscretas, nPuntosT, xCntNeuronasPorCapa, tipoSaturacionPenultimaCapa, tipoSaturacionSalida );
  CompletarParasito( res );
  result:= res;
end;


procedure TAdminEstadosCerebro.devxr_continuo(irx: integer;
  kpuntoT: integer; out dCdx_Inc, dCdx_Dec: NReal; out resCod: integer; out
  xrpos: NReal);

begin
  resCod:=0;
  xrpos:=0;
  dCdx_inc:= dCFdxrxd[irx];
  dCdx_dec:= dCdx_inc;
end;

function TAdminEstadosCerebro.deltaCosto_vxr_continuo(irx: integer;
  kpuntoT: integer; delta_xr: NReal): NReal;

var
  c0, c1: NReal;
  xr0: NReal;
begin
  c0 := costoContinuo( kPuntoT );
  xr0:= xr[irx];
  xr[irx]:= xr0+delta_xr;
  c1 := costoContinuo( kPuntoT );
  xr[irx]:= xr0;
  Result:= c1 - c0;
end;

procedure TAdminEstadosCerebro.ActualizarEstadoGlobal(kPaso: integer);
var
  aCerebro: TCerebro;
  jOffset, jEntrada: integer;
begin
  aCerebro:= cerebros[kPaso];

  aCerebro.BackPropagation_init;

  for jEntrada:= 0 to high( xr ) do
    aCerebro.SetEntrada( jEntrada, xr[jEntrada] );

  jOffset:= length( xr );
  for jEntrada:= 0 to high( xd ) do
    aCerebro.SetEntrada( jOffset + jEntrada, xd[ jEntrada ] );

  aCerebro.evaluar;
  CF:= aCerebro.GetSalida( 0 );
  aCerebro.CalcGradX( 0 );
  aCerebro.GetGradX( dCFdxrxd );

end;


end.

