unit utestMiner2012;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  xmatdefs,
  uauxiliares,
  ufxgx, uresfxgx,
  matreal,
  uSimplex, uMIPSImplex, uListaViolacionesPermitidasSimplex, uproblema;

type

  { TFormMiner2012 }

  TFormMiner2012 = class(TForm)
    btSimplex1: TButton;
    btCrearMinero: TButton;
    btResolver: TButton;
    btResolverSIMPLEX: TButton;
    GroupBox1: TGroupBox;
    memo_salida: TMemo;
    OpenDialog1: TOpenDialog;
    procedure btCrearMineroClick(Sender: TObject);
    procedure btResolverClick(Sender: TObject);
    procedure btResolverSIMPLEXClick(Sender: TObject);
    procedure btSimplex1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }


    spx: TMipSimplex;

    minero: TProblema_m01;

    procedure LoadCasoSimplex(const archi: string);
    procedure wrln(s: string);
  end;

var
  FormMiner2012: TFormMiner2012;

implementation

{$R *.lfm}

procedure TFormMiner2012.wrln(s: string);
begin
  memo_salida.Lines.add(s);
end;

procedure TFormMiner2012.btSimplex1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    self.LoadCasoSimplex( OpenDialog1.FileName );
end;

procedure TFormMiner2012.FormCreate(Sender: TObject);
begin
  spx := nil;
  minero := nil;
end;

procedure TFormMiner2012.btCrearMineroClick(Sender: TObject);
var
  rcombilin: Tfx_lineal_x;
  kres: integer;

  ivars: TDAOfNInt;
  coefs: TDAOfNReal;

  jcol, cnt: integer;
  j: integer;

  Lambda, X: TVectR;
  nIters: integer;
  ValCosto, ValLagrangiana, dF2: NReal;
  flg_Convergio: boolean;
  d2: NReal;

begin
  if minero <> nil then
    minero.Free;

  minero := TProblema_m01.Create_init(
    spx.nf, // cantidad de ecuaciones = restricciones más función objetivo.
    spx.nc, // total de vairables nr + ne
    0, // variables enteras ne.
    spx.fGetNombreVar, spx.fGetNombreRes); // funciones auxiliares para debug

  // cargamos las restricciones
  for kres := 0 to spx.nf - 2 do
  begin
    setlength(ivars, spx.nc);
    setlength(coefs, spx.nc);
    cnt := 0;
    for jcol := 1 to spx.nc - 1 do
    begin
      if abs(spx.e(kres + 1, jcol)) > asumaCero then
      begin
        ivars[cnt] := jcol;
        coefs[cnt] := spx.e(kres + 1, jcol);
        Inc(cnt);
      end;
    end;
    setlength(ivars, cnt);
    setlength(coefs, cnt);

    rcombilin := Tfx_lineal_x.Create(ivars, coefs, spx.e(kres + 1, spx.nc));
    (minero.restricciones[kres].fx as Tfx_sumatoria).fxs.add(rcombilin);
  end;

  kres := spx.nf - 1;
  setlength(ivars, spx.nc);
  setlength(coefs, spx.nc);
  cnt := 0;
  for jcol := 1 to spx.nc - 1 do
  begin
    if abs(spx.e(kres + 1, jcol)) > asumaCero then
    begin
      ivars[cnt] := jcol;
      coefs[cnt] := -spx.e(kres + 1, jcol);
      Inc(cnt);
    end;
  end;
  setlength(ivars, cnt);
  setlength(coefs, cnt);
  rcombilin := Tfx_lineal_x.Create(ivars, coefs, -spx.e(kres + 1, spx.nc));
  (minero.f as Tfx_sumatoria).fxs.add(rcombilin);

  // fijamos las retricciones de caja
  for j := 1 to spx.nc - 1 do
  begin
    //    minero.cota_inf_set( j, spx.x_inf.e( j ) );
    minero.cota_inf_set(j, 0);
    case spx.flg_x[j] of
      1: minero.cota_sup_set(j, spx.x_sup.e(j) - spx.x_inf.e(j));
      2: minero.FijarVariable(j, 0);
    end;
  end;

  // ahora fijamos el tipo de restricción
  for j := 1 to spx.nf - 1 do
  begin
    case spx.flg_y[j] of
      0: minero.restricciones[j - 1].tipo := TR_Mayor;
      -2, 2: minero.restricciones[j - 1].tipo := TR_Igualdad;
    end;
  end;


  minero.DumpToArchi('debug_minero.xlt');

end;

procedure TFormMiner2012.btResolverClick(Sender: TObject);
var
  lambda, X: TVectR;
  niters: integer;
  valcosto: NReal;
  convergio: boolean;
  k: integer;
  valLagrangiana, dFrontera2: NReal;
begin
  if minero <> nil then
  begin
    Lambda:= TVectR.Create_Init( minero.NRestricciones );
    X:= TVectR.Create_Init( minero.NVariables );

    randseed := 31;
    for k := 1 to X.n do
      x.pon_e(k, random);
    minero.EstimarMultiplicadores(X, 1);

    for k := 1 to 30 do
    begin
      writeln('MaxInBox_Dual_', k);
      minero.MaxInBox_Dual(Lambda, X, 1, 1E-14, 1000, niters, valcosto,
        valLagrangiana, dFrontera2, convergio, False);
      writeln('f: ', minero.f.f(X): 12: 4, ' NITers: ', niters);
      minero.PrintSatus('minero_status.txt', k > 1, x);
      readln;
    end;

    lambda.Free;
    X.Free;
  end;
end;

procedure TFormMiner2012.btResolverSIMPLEXClick(Sender: TObject);
begin
  spx.resolver;
end;



type
  TRec_ivae_ires = class
    kvar, ivae, ires: integer;
    constructor Create(kvar_, ivae_, ires_: integer);
  end;

constructor TRec_ivae_ires.Create(kvar_, ivae_, ires_: integer);
begin
  inherited Create;
  kvar := kvar_;
  ivae := ivae_;
  ires := ires_;
end;


procedure TFormMiner2012.LoadCasoSimplex(const archi: string);
var
  jcol: integer;
  buscando: boolean;
  r: string;
  cnt_Variables, cnt_Restricciones: integer;

  k, j: integer;
  kk: integer;
  ires: integer;

  lstve: TDAOfNInt;
  xlstAcoplesVEnts: TDAOfAcoplesVEnts;
  NEnteras,
  nViolacionesPermitidas: integer;
  ficha: TFichaViolacionPermitida;
  nIvars: integer;
  iVars: TDAofNInt;
  listaViolacionesPermitidas: TListaViolacionesPermitidasSimplex;

  xf: textfile;
  kfilx: integer; // fila de las x: en la planilla

  lstRecs: TList;
  cnt: TDAofNInt;
  pal: string;
  kk_ant: integer;
  ivae: integer;
  jRec: integer;
  aRec: TRec_ivae_ires;
  ivar: integer;
  nombre_col, nombre_fil: TDAofString;



function nextpal( var r: string ): string;
begin
  result:= getNextPalSep( r, #9 );
end;

begin

  assignfile(xf, archi);
  reset(xf);


  if (spx <> nil) then
    spx.Free;


  try

    kfilx := 1;
    jcol := 1;

    kfilx := 2;
    readln(xf);

    readln(xf, r);
    pal := NextPal(r);

    if pos('NEnteras:', pal) = 1 then
    begin
      NEnteras := NextInt(r);

      setlength(lstve, NEnteras);
      for k := 0 to high(lstve) do
        lstve[k] := nextInt(r);

      setLength(xlstAcoplesVEnts, NEnteras);
      setLength(cnt, NEnteras);
      lstRecs := TList.Create;
      //paso la lista de variables enteras y el ivae VarAcoplada ResAcoplada
      readln(xf, r); // 'ivae', #9, 'VarAcoplada', #9, 'ResAcoplada');
      kk_ant := 0;
      j := 0;
      readln(xf, r);
      if NEnteras > 0 then
      begin
        while pos('NVariables', r) = 0 do
        begin
          kk := nextInt(r);
          ivae := nextInt(r);
          ires := nextInt(r);
          lstRecs.add(TRec_ivae_ires.Create(kk, ivae, ires));
          if kk = kk_ant then
          begin
            Inc(j);
          end
          else
          begin
            cnt[kk_ant] := j;
            j := 0;
            kk_ant := kk;
          end;
          readln(xf, r);
        end;
        cnt[kk_ant] := j;
      end;

      jRec := 0;
      for k := 0 to high(xlstAcoplesVEnts) do
      begin
        setLength(xlstAcoplesVEnts[k], cnt[k]);
        for  j := 0 to cnt[k] - 1 do
        begin
          aRec := lstRecs.items[jRec];
          Inc(jRec);
          xlstAcoplesVEnts[k][j].ivar := aRec.ivae;
          xlstAcoplesVEnts[k][j].ires := aRec.ires;
        end;
      end;
    end
    else
      NEnteras := 0;


    (*** COMIENZA LECTURA DE TSimplex ***)
    if pos( 'NVariables', r ) = 0 then raise Exception.Create('Error, se esperaba NVariables, vino: '+r);
    pal := nextPal(r);
    cnt_Variables := nextInt(r);

    readln(xf, r);
    pal := nextPal(r);
    cnt_Restricciones := nextInt(r);

    //creamos el simplex
    spx := TMIPSimplex.Create_init(cnt_Restricciones + 1, cnt_Variables +
      1, NEnteras, nil, nil);

    readln(xf, r);
    pal := nextPal(r);
    spx.cnt_varfijas := nextInt(r);


    readln(xf, r);
    pal := nextPal(r);
    spx.cnt_RestriccionesRedundantes_ := nextInt(r);

    readln(xf, r);
    pal := nextPal(r);
    spx.cnt_ViolacionesUsadas := nextInt(r);

    listaViolacionesPermitidas := TListaViolacionesPermitidasSimplex.Create;

    readln(xf, r); // violacionesPermitidas
    readln(xf, r); // violacionesPermitidas.Count=
    pal:= nextPal( r );
    nViolacionesPermitidas := nextInt(r);
    listaViolacionesPermitidas.Capacity := nViolacionesPermitidas;

    readln(xf, r); // ires  usada  iViolacionAUsar  nIvars  ivars[]
    for k := 1 to nViolacionesPermitidas do
    begin
      readln(xf, r);
      ires := nextInt(r);
      kk := nextInt(r);
      ivar := nextInt(r);
      ires := nextInt(r);
      nIvars := nextInt(r);
      SetLength(iVars, nIvars);
      if nIvars > 0 then
        for j := 0 to high(iVars) do
        begin
          readln(xf, r);
          iVars[j] := nextInt(r);
        end
      else
        readln(xf, r);
      ficha := TFichaViolacionPermitida.Create(kk, iVars);
      listaViolacionesPermitidas.Add(ficha);
    end;


    for k := 0 to listaViolacionesPermitidas.Count - 1 do
    begin
      ficha := listaViolacionesPermitidas[k];
      readln(xf, r);
      kk := nextInt(r);
      ficha.usada := nextInt(r) <> 0;
      ficha.iViolacionAUsar := nextInt(r);
    end;

    // Ahora busco el inicio de la matriz.

    buscando := True;
    kfilx := 1;
    while buscando and (kfilx < 1000) do
    begin
      readln(xf, r);
      if pos('x:', r) = 1 then
        buscando := False
      else
        Inc(kfilx);
    end;

    if buscando then
      raise Exception.Create('No encontré la fila del asl x: ');


    pal:= nextPal( r ); // x:
    for ivar := 0 to cnt_variables - 1 do
    begin
      pal := nextPal(r);
      spx.nombreVars[ivar] := pal;
    end;

    spx.violacionesPermitidas.Free;
    spx.violacionesPermitidas := listaViolacionesPermitidas;


    readln(xf, r);
    pal := nextPal(r); // x_inf
    for j := 1 to cnt_variables do
      spx.x_inf.pv[j] := NextFloat(r);

    readln(xf, r);
    pal := nextPal(r); // x_sup
    for j := 1 to cnt_variables do
      spx.x_sup.pv[j] := NextFloat(r);

    spx.cnt_varfijas := 0;
    readln(xf, r);
    pal := nextPal(r); // flg_x
    for j := 1 to cnt_variables do
    begin
      spx.flg_x[j] := NextInt(r);
      if spx.flg_x[j] = 2 then
        Inc(spx.cnt_varfijas);
    end;

    spx.cnt_igualdades := 0;
    readln(xf, r);
    pal := nextPal(r); // flg_y
    for j := 1 to cnt_Restricciones do
    begin
      spx.flg_y[j] := NextInt(r);
      if spx.flg_y[j] = 2 then
        Inc(spx.cnt_igualdades);
    end;

    readln(xf, r);
    pal := nextPal(r); // top
    for j := 1 to cnt_variables do
      spx.top[j] := NextInt(r);

    readln(xf, r);
    pal := nextPal(r); // left
    for j := 1 to cnt_Restricciones do
      spx.left[j] := NextInt(r);

    spx.rearmarIndicesiiXiiY;


    //  TMIPSimplex(spx).lstAcoplesVEnts:= xlstAcoplesVEnts;
    for j := 1 to NEnteras do
    begin
      if xlstAcoplesVEnts[j - 1][0].ivar <> -1 then
        TMIPSimplex(spx).set_EnteraConAcoples(j, lstve[j - 1], trunc(
          spx.x_sup.pv[lstve[j - 1]] + 0.1),
          xlstAcoplesVEnts[j - 1])
      else
        spx.set_entera(j, lstve[j - 1], trunc(spx.x_sup.pv[lstve[j - 1]] + 0.1));
    end;

    readln(xf, r); // -------
    readln(xf, r); // sistema ------
    readln(xf, r); // .......


    // cargamos la matriz
    setlength(nombre_col, spx.nc);
    readln(xf, r); // encabezado de las columnas de la matriz
    pal := nextPal(r);
    for k := 0 to high(nombre_col) do
      nombre_col[k] := nextPal(r);

    setlength(nombre_fil, spx.nf);

    for k := 1 to cnt_Restricciones + 1 do
    begin
      readln(xf, r);
      nombre_fil[k - 1] := nextPal(r); // Nombre de la restricción

      for j := 1 to cnt_Variables + 1 do
      begin
        pal:= nextPal( r );
        if pos( '>=', pal ) > 0 then
           delete( pal, 1, pos( '>=', pal )+1 );
        spx.pon_e(k, j, nextFloat(pal));
      end;
    end;

    // Desenredamos los nombres de las restricciones
    for j := 1 to cnt_Restricciones do
    begin
      if spx.iiy[j] > 0 then
        spx.nombreRest[j] := nombre_fil[spx.iiy[j] - 1]
      else
        spx.nombreRest[j] := nombre_col[-spx.iiy[j] - 1];
    end;
    setlength(nombre_col, 0);
    setlength(nombre_fil, 0);

    wrln('Simplex cargado. NFils: ' + IntToStr(spx.nf) + ', NCols: ' + IntToStr(spx.nc));

  finally
    closefile(xf);
  end;
end;


end.
