unit uintermediariocostofuturo;
{$mode delphi}
interface
uses
  Classes, SysUtils, xmatdefs, uestados, umipsimplex, uCosaConNombre, Math,
  usimplex,uVarDefs,ucosaparticipedemercado, uglobs;

type
  // Tipo de restricciones en la derivada direccional del gradiente
  // este tipo para definir el tipo de restriccion, la comparacion es entre la
  // variable y la restriccion, por ejemplo si es MAYOR significa
  // variable > restriccion.valor
  TTipoDeRestriccionGrad = (IGUAL, MENOR, MAYOR, POSITIVO, NEGATIVO,SUMAR);


  { TRestriccionGradiente }
  TRestriccionGradiente = class
    tipo: TTipoDeRestriccionGrad;
    valor: NReal;// indica el valor contra el que comparar la variable
    constructor Create(atipo: TTipoDeRestriccionGrad; avalor: NReal);
  end;

  TDAOfRestriccionGradiente = array of TRestriccionGradiente;

  { TIntermediarioCostoFuturo }

  TIntermediarioCostoFuturo = class(TCosaParticipeDeMercado)
    CF: TAdminEstados; // Administrador de la función de Costo Futuro.

    gradiente_xr, gradiente_xd: TDAofNReal;
    xr: TDAOfNreal; // estado continuo
    xd: TDAOfNInt; // estado discreto

    idx_SPX_xr, idx_SPX_xd: TDAOfNInt; // indices de la posición en el Simplex
      // de cada una de las variables de estado.

    ivarCFSPX, iresCFSPX_base: integer;

    // indice del CF_Xs en el simplex en variable y en restriccion
    restricciones_xr, restricciones_xd: TDAOfRestriccionGradiente;

    nombres_xr,nombres_xd,unidades_xr,unidades_xd:TDAofString;

    // contador de variable registrada
    // se inicializa a cero con Create y Clear y se incrementa con cada registro
    cnt_var_registrada: integer;

    costoFuturoDelEstadoActual: NReal;

    pubvarlst: TListaVarDefs; // lista de variables pinchables

    constructor Create;

    procedure PrepararMemoria(Catalogo: TCatalogoReferencias; globs: TGlobs); override;

    function getNombreVar(ivar: integer; var nombre: string): boolean;
    function getNombreRes(ires: integer; var nombre: string): boolean;

    // registra los indices de una variable de estado en el Costo Futuro y en el Simplex y la restriccion sobre el gradiente
    procedure registrarVariableContinua(iCF, iSPX: integer;
      restriccion: TRestriccionGradiente; nombreVar, unidades: string);
    procedure registrarVariableDiscreta(iCF, iSPX: integer;
      restriccion: TRestriccionGradiente; nombreVar, unidades: string);

    // trae el gradiente del Costo Futuro en kPaso
    procedure getGradiente( kPaso: integer; fActPaso: NReal);
    procedure getEstadoActual( kPaso: integer);

    // cagra el gradiente en en simplex segun los inices definidos en idxCF e idxSPX
    procedure cargarGradienteEnSimplex(s: TMIPSimplex);
    procedure Clear;

    procedure PubliVars; override;
    procedure opt_nvers( var ivar, {%H-}ivae, ires: integer );
    {$IFDEF SPXCONLOG}
    procedure spx_NombrarVariables(s: TSimplex; cnt_vars, cnt_ress: integer );
    {$ENDIF}

    function aplicarRestriccion(restriccion: TRestriccionGradiente; valorOriginal: NReal): NReal;
  end;



implementation

function TIntermediarioCostoFuturo.aplicarRestriccion(restriccion: TRestriccionGradiente;
  valorOriginal: NReal): NReal;
var
  valorRes: NReal;
  tipoRes: TTipoDeRestriccionGrad;
  res: NReal;
begin
  res := 0;
  valorRes := restriccion.valor;
  tipoRes := restriccion.tipo;
  case tipoRes of
    MAYOR: res := max(valorOriginal, valorRes);
    MENOR: res := min(valorOriginal, valorRes);
    IGUAL: res := valorRes;
    POSITIVO: res := max(valorOriginal, 0);
    NEGATIVO: res := min(valorOriginal, valorRes);
    SUMAR: res := valorOriginal + valorRes;
  end;
  Result := res;
end;

{ TRestriccionGradiente }

constructor TRestriccionGradiente.Create(atipo: TTipoDeRestriccionGrad; avalor: NReal);
begin
  tipo := atipo;
  valor := avalor;
end;

{ TIntermediarioCostoFuturo }

constructor TIntermediarioCostoFuturo.Create;
begin
  inherited Create(capa, 'IntermediarioCF');
  cnt_var_registrada:= 0;
end;

procedure TIntermediarioCostoFuturo.PrepararMemoria(
  Catalogo: TCatalogoReferencias; globs: TGlobs);
var
  kVariable, NContinuas, NDiscretas:integer;
begin
  inherited PrepararMemoria(Catalogo, globs);
  self.CF:= globs.CF;

  NContinuas:=CF.nVarsContinuas;
  NDiscretas:=CF.nVarsDiscretas;

  SetLength( idx_SPX_xr, NContinuas );
  SetLength( idx_SPX_xd, NDiscretas );

  SetLength( xr, NContinuas );
  setlength( xd, CF.nVarsDiscretas );

  SetLength(gradiente_xr, NContinuas );
  SetLength(gradiente_xd, NDiscretas);

  SetLength(restricciones_xr, NContinuas );
  SetLength(restricciones_xd, NDiscretas);

  SetLength(nombres_xr, NContinuas );
  SetLength(nombres_xd, NDiscretas );

  SetLength(unidades_xr, NContinuas );
  SetLength(unidades_xd, NDiscretas );

  for kVariable:=0 to NContinuas - 1 do
  begin
    nombres_xr[kVariable]:=CF.xr_def[kVariable].nombre;
    unidades_xr[kVariable]:=CF.xr_def[kVariable].unidades;
  end;

  for kVariable:=0 to NDiscretas - 1 do
  begin
    nombres_xd[kVariable]:=CF.xd_def[kVariable].nombre;
    unidades_xd[kVariable]:=CF.xd_def[kVariable].unidades;
  end;

end;

function TIntermediarioCostoFuturo.getNombreVar(ivar: integer;
  var nombre: string): boolean;
begin
  if ivar = ivarCFSPX then
  begin
    nombre := 'CF';
    Result := True;
  end
  else
  begin
    nombre := '';
    Result := False;
  end;
end;

function TIntermediarioCostoFuturo.getNombreRes(ires: integer;
  var nombre: string): boolean;
begin
  if ires = iresCFSPX_base then
  begin
    nombre := 'CF(Xs) >= CF(Xo) + grad(CF(Xo)).(Xs-Xo)';
    Result := True;
  end
  else
  begin
    nombre := '';
    Result := False;
  end;
end;

procedure TIntermediarioCostoFuturo.registrarVariableContinua(iCF,
  iSPX: integer; restriccion: TRestriccionGradiente; nombreVar, unidades: string
  );
begin
  // agarrar el costo futuro y casarlo con el indice de la variable dinamica del actor
  idx_SPX_xr[ iCF ] := iSPX;
  restricciones_xr[ iCF ] := restriccion;
  nombres_xr[ iCF ] := nombreVar;
  unidades_xr[ iCF ] := '[' + unidades + ']';
  inc( cnt_var_registrada );
end;

procedure TIntermediarioCostoFuturo.registrarVariableDiscreta(iCF,
  iSPX: integer; restriccion: TRestriccionGradiente; nombreVar, unidades: string
  );
begin
  // agarrar el costo futuro y casarlo con el indice de la variable dinamica del actor
  idx_SPX_xd[ iCF ] := iSPX;
  restricciones_xd[ iCF ] := restriccion;
  nombres_xd[ iCF ] := nombreVar;
  unidades_xd[ iCF ] := '[' + unidades + ']';
  inc( cnt_var_registrada );
end;


procedure TIntermediarioCostoFuturo.getGradiente(kPaso: integer; fActPaso: NReal
  );
var
  kr, kd, resCod: integer;
  dCdx_Inc, dCdx_Dec, xrpos: NReal;
begin

  for kr:= 0 to CF.nVarsContinuas - 1 do
  begin
    CF.devxr_continuo( kr, kPaso, dCdx_Inc, dCdx_Dec, resCod, xrpos);
    gradiente_xr[kr] := (dCdx_Dec + dCdx_Inc) / 2 * fActPaso;

    if (-gradiente_xr[kr]) < 1e-2 then
      gradiente_xr[kr] := -1e-2;

    if restricciones_xr[kr] <> nil then
      gradiente_xr[kr] := aplicarRestriccion(restricciones_xr[kr], gradiente_xr[kr]);
  end;

  for kd:= 0 to CF.nVarsDiscretas - 1 do
  begin
    raise Exception.Create( 'OJO; derivando variables enteras SIN PENSAR' );

    dCdx_Inc:= CF.deltaCosto_vxd_continuo( kd, kPaso, 1 );
    dCdx_Dec:= CF.deltaCosto_vxd_continuo( kd, kPaso, -1 );

    gradiente_xd[kd] := (dCdx_Dec + dCdx_Inc) / 2 * fActPaso;

    if (-gradiente_xd[kd]) < 1e-2 then
      gradiente_xr[kd] := -1e-2;

    if restricciones_xd[kd] <> nil then
      gradiente_xd[kd] :=
        aplicarRestriccion(restricciones_xd[kd], gradiente_xd[kd]);
  end;

end;

procedure TIntermediarioCostoFuturo.getEstadoActual(kPaso: integer);
begin
  vcopy( xr, CF.xr );
  vcopy( xd, CF.xd );
  costoFuturoDelEstadoActual := CF.costoContinuo(kPaso);
end;

procedure TIntermediarioCostoFuturo.cargarGradienteEnSimplex(s: TMIPSimplex);
var
  kr, kd: integer;
begin

  // esta restriccion es CF(Xs) >= CF(X) + grad(CF(X))*(Xs - X)
  // --> CF(Xs) - CF(X) + grad(CF(X))*X - suma(grad(CF(X)[i]*Xs[i]) >= 0
  for kr:= 0 to CF.nVarsContinuas - 1 do
  begin
    // carga -gradiente en las variables de estado
    s.pon_e(s.nf - 1, idx_SPX_xr[kr], -1 * gradiente_xr[ kr]);
    // acumula en el termino independiente
    s.acum_e(s.nf - 1, s.nc, gradiente_xr[ kr ] * xr[ kr] );
  end;

  for kd:= 0 to CF.nVarsDiscretas - 1 do
  begin
    // carga -gradiente en las variables de estado
    s.pon_e(s.nf - 1, idx_SPX_xd[kd], -1 * gradiente_xd[ kd]);
    // acumula en el termino independiente
    s.acum_e(s.nf - 1, s.nc, gradiente_xd[ kd ] * xr[ kd] );
  end;


  // el 1 en su propia restriccion
  s.pon_e(s.nf - 1, s.nc - 1, 1);
  // el -CF(X) en el ti
  s.acum_e(s.nf - 1, s.nc, -1 * costoFuturoDelEstadoActual);
  // - CF(Xs) en la funcion de costo
  s.pon_e(s.nf, s.nc - 1, -1);

  // Ponemos cota superior al CF
  s.cota_sup_set(s.nc - 1,MaxInt);// sacar


  // s.nc es el ti
  // s.nc - 1 es el CF_Xs

  // s.nf es la funcion de costo
  // s.nf - 1 es la restriccion del gradiente

end;

procedure TIntermediarioCostoFuturo.Clear;
var
  k: integer;
begin
  for k := 0 to high( restricciones_xr ) do
    freeAndNil( restricciones_xr[ k ] );
  for k := 0 to high( restricciones_xd ) do
    freeAndNil( restricciones_xd[ k ] );
end;

procedure TIntermediarioCostoFuturo.PubliVars;
var
  kVariable:integer;
begin
  Inherited PubliVars;
  for kVariable:=0 to high(xd) do
    PublicarVariableNI(nombres_xd[kVariable], unidades_xd[kVariable], xd[kVariable],True);
  for kVariable:=0 to high(xr) do
    PublicarVariableNR(nombres_xr[kVariable], unidades_xr[kVariable],12,1, xr[kVariable],True);
end;

procedure TIntermediarioCostoFuturo.opt_nvers(var ivar, ivae, ires: integer);
begin
  ivarCFSPX:= ivar;
  inc( ivar );
  iresCFSPX_base:= ires;
  inc( ires ); // por ahora solo una
end;

{$IFDEF SPXCONLOG}
procedure TIntermediarioCostoFuturo.spx_NombrarVariables(s: TSimplex; cnt_vars, cnt_ress: integer );
var
  kvar, kres: integer;
  s_nombre: string;
  bres: boolean;

begin
  if getNombreVar(ivarCFSPX, s_nombre) then
    s.set_NombreVar(ivarCFSPX, s_nombre);
  if getNombreRes(iresCFSPX_base,s_nombre) then
    s.set_NombreRest(iresCFSPX_base,s_nombre);
end;
{$ENDIF}

end.
