//M. Forets           @  iie    2011
unit opt_gpa;

{$mode objfpc}{$H+}

{$MACRO ON}
//define el plan particular
{$define uplan := uplanreductor}
{$define TPlan := TPlanReductor}
interface

uses
  Classes, SysUtils,
  dbPlanesPrueba,
  uplan,
  xMatDefs, Math;

function nuevoPlanGPA(NT, NGamma: integer; criterio: integer): TPlan;

//function obtener_dsBaseDeDatos(N, NIndividuos, criterio: integer): TResultadoQuery;
function obtener_dsBaseDeDatos(N, NIndividuos, criterio: Integer): TDAOfTPlanPrueba;

//function decodificarPlan(r: TDataRecord): TPlan;
function decodificarPlan(r: TPlan): TPlan;

//function obtener_planesBaseDeDatos(N: Integer; ds: TResultadoQuery): TDaOfTPlan;
function obtener_planesBaseDeDatos(N: Integer; ds: TDaOfTPlanPrueba): TDaOfTPlanPrueba;

function obtener_pid(planBaseDeDatos: TDaofTPlanPrueba): TDAOfNInt;

function buscarPlan(idPlan: Integer; planBaseDeDatos: TDaofTPlanPrueba): TPlan;

function calcular_Deltaxk(planes: TDaofTPlanPrueba; xAster: TPlan): TDAOfDAofNReal;

function calcular_rk(Deltaxk: TDAOfDAofNReal): TDAOfNReal;

function calcular_Deltafk(planes: TDAofTPlanPrueba; xAster: TPlan): TDAOfNReal;

function calcular_dk(rk: TDAOfNReal; Deltafk: TDAOfNReal): TDaofNReal;

function calcular_S(dk: TDaOfNReal): NReal;

function calcular_xgp(S: NReal; Deltafk: TDaOFNreal; Deltaxk: TDAOfDAOfNReal;  rk : TDaofNReal; xAster: TPlan): TPlan;


implementation
/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
//función principal
/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
// obtiene un nuevo plan mediante un algoritmo de gradiente promedio con puntajes
// utilizando resultados previos de la base de datos.
// inputs:    NT          - el subconjunto del total de la poblacion (NIndividuos) que considero para la evaluacion
//            NGamma      - los que tomo en cada colección para reducir T a Gamma
//            criterio    - entero que indica la función a minimizar
// outputs:   TPlan       - nuevo plan para probar
function nuevoPlanGPA(NT, NGamma: integer; criterio: integer): TPlan;
var
  orderBy:                          String;
  NIndividuos, i:                   Integer;
  //estructuras de datos de SQL:
  //dsBaseDeDatos:                    TResultadoQuery;
  dsBaseDeDatos:                      TDaOfTPlanPrueba;
  //estructuras de datos para los planes
  xAster:                           TPlan;
  planesBaseDeDatos:                TDAOfTPlanPrueba;
  planesGamma, planesGamma_p:       TDAOfTPlanPrueba;
  pidSegun_cEvaluacion:             TDAOfNInt;
  //calculo de gp
  Deltaxk:                          TDAOfDAOfNReal;
  rk, Deltafk, dk:                  TDAOfNReal;
  S:                                NReal;
  xgp:                              TPlan;
begin
  (*
  if criterio == 777 then           //criterio aleatorio
  begin
    if random < 0.5 then
       if random < 0.5 then
          criterio:= 0
       else
          criterio:= 1
    else
    if random < 0.5 then
       criterio:= 2
    else
        criterio:= 3;
  end;


  case criterio of
      0: orderby    := ' ORDER BY cad ';
      1: orderby    := ' ORDER BY cpialfa ';
      2: orderby    := ' ORDER BY cadpe5 ';
      3: orderby    := ' ORDER BY cpibeta ';
  end;
  *)

  //1.1 obtener individuos de la base de datos, ordenados por criterio de evaluacion (menor f)
  NIndividuos                := Poblacion_count;
  dsBaseDeDatos              := obtener_dsBaseDeDatos(NT, NIndividuos,criterio);
  planesBaseDeDatos          := obtener_planesBaseDeDatos(NT, dsBaseDeDatos);
  pidSegun_cEvaluacion       := obtener_pid(planesBaseDeDatos);

  //1.2 asignar el plan optimo actual (xAster)
  xAster                     := planesBaseDeDatos[0];

  //2.1 calcular Gamma. . .
  //planesGamma              := calcular_Gamma(NGamma, planesBaseDeDatos, vectoresCon_pid);
  setlength(planesGamma, NGamma);
  setlength(planesGamma_p, NGamma-1);

  //sacar el plan xAster de planesGamma (que es el primer elemento del array)
  for i := 0 to NGamma-2 do
  begin
      planesGamma_p[i]    :=   planesBaseDeDatos[i+1];
  end;


  //Calcular cantidades
  Deltaxk    :=        calcular_Deltaxk(planesGamma_p, xAster);
  Deltafk    :=        calcular_Deltafk(planesGamma_p, xAster);
  rk         :=        calcular_rk(Deltaxk);
  dk         :=        calcular_dk(rk, Deltafk);

  S          :=        calcular_S(dk);
  xgp        :=        calcular_xgp(S, Deltafk, Deltaxk, rk, xAster);

  //1.2 obtener un registro con los primeros NGamma ordenados por cercania al xAster: vSegun_cCercania
  //. . .
  //pidSegun_cCercania := obtener_pid();

  //2.1 asignar coeficientes de puntaje

  //2.2 asignar puntajes a los elementos de vSegun_cEvaluacion

  //2.3 asignar puntajes a los elementos de vSegun_cCercania

  //3 calcular Gamma

  //4.1 calcular Delta f_k y Delta x_k

  //4.2 calcular S

  //4.3 calcular nuevo plan

  //4.4 devolverlo
  Result          :=   xgp;

end;
/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
//AQUI COMIENZAN LAS FUNCIONES AUXILIARES de uplanesGPA
/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
function obtener_dsBaseDeDatos(N, NIndividuos, criterio: Integer): TDAOfTPlanPrueba;
begin
      Result:=dbPlanesPrueba.returnOrdList(N,criterio);
end;

function decodificarPlan(r: TPlan): TPlan;
begin
  Result:=r;
end;

function obtener_planesBaseDeDatos(N: Integer; ds: TDaOfTPlanPrueba): TDaOfTPlanPrueba;
begin
     Result:= ds;
end;

function obtener_pid(planBaseDeDatos: TDaofTPlanPrueba): TDAOfNInt;
var
  arn     : TDAOfNInt;
  N, i    : Integer;
begin
     N := length(planBaseDeDatos);
     setlength(arn, N);
     for i := 0 to N-1 do
     begin
         arn[i] := planBaseDeDatos[i].idPlan;
     end;
     Result := arn;

end;

//busca un plan completo conociendo solamente el idPlan
function buscarPlan(idPlan: Integer; planBaseDeDatos: TDaofTPlanPrueba): TPlan;
begin
     Result:=dbPlanesPrueba.returnOne(idPlan);

end;

function calcular_Deltaxk(planes: TDaofTPlanPrueba; xAster: TPlan): TDAOfDAofNReal;
var
   anr     :   TDAOfDAofNReal;
   N       :   Integer;
   i,j     :   Integer;
   lx      :   Integer;
   auxArr  :   TDaOfNReal;
begin
     N:= length(planes); //cantidad de planes de Gamma'
     setlength(anr,N); //el vector tiene N diferencias, i.e. xk-x* con k=0,...,N-1
     //a su vez cada elemento tiene una cantidad fija de variables (lx):
     lx:=length(planes[0].adn);
     setlength(auxArr, lx);

     for i:= 0 to N-1 do
     begin
          for j:= 0 to lx-1 do
          begin
               auxArr[j] := planes[i].adn[j]-xAster.adn[j];
          end;
          anr[i] := auxArr;
     end;
     Result:= anr;
end;

function calcular_rk(Deltaxk: TDAOfDAofNReal): TDAOfNReal;
var
 aux, vD: TDAOfNReal;
 N:   Integer;
 xl:  Integer;
 i,j: Integer;
 begin
  N:= length(Deltaxk);     //cantidad de planes en gamma'
  setlength(aux,N);

  xl:= length(Deltaxk[0]); //tamaño de un vector x
  setlength(vD, xl);

     for i:=0 to N-1 do
     begin
          vD := Deltaxk[i];

          aux[i]:= 0;
          for j:= 0 to xl-1 do
          begin
              aux[i] := aux[i] + sqr(vD[j]);
          end;
          aux[i] := sqrt(aux[i]);
     end;

  Result:= aux;

end;

function calcular_Deltafk(planes: TDAofTPlanPrueba; xAster: TPlan): TDAOfNReal;
var
   auxf: TDAOfNReal;
   i:    Integer;
   N:    NInt;
begin

     N := length(planes); //cantidad de elementos de Gamma'
     setlength(auxf, N);

     for i:= 0 to N-1 do
     begin
          auxf[i] := planes[i].fCriterio1 - xAster.fCriterio1;
     end;
     Result:= auxf;
end;

function calcular_dk(rk: TDAOfNReal; Deltafk: TDAOfNReal): TDaofNReal;
var
N, i:     Integer;
auxr:     TDaOfNreal;
begin
     N    := length(rk);
     setlength(auxr,N);
     for i:= 0 to N-1 do
     begin
           if not (rk[i] = 0) then
              auxr[i] := Deltafk[i]/rk[i];        //OJO, el caso en que rk[i]=0 tiene que ser considerado aparte!!
     end;
     Result:= auxr;

end;

function calcular_S(dk: TDaOfNReal): NReal;
var
   i: Integer;
   aux: NReal;
begin
      aux:= 0.0;
      for i:= 0 to length(dk)-1 do
      begin
           aux:= aux+dk[i];
      end;
      Result:= aux;

end;

function calcular_xgp(S: NReal; Deltafk: TDaOFNreal; Deltaxk: TDAOfDAOfNReal;  rk : TDaofNReal; xAster: TPlan): TPlan;

var
  i, j, N, lue:  Integer;
  xa:            TDaOfNReal;
  xp:            TPlan;
  acumR:         NReal;
  xr:            TDAOfNReal;
begin

  setlength(xr, length(Deltaxk[0]));
  xr        := Deltaxk[0];
  lue       := length(xr);
  N         := length(Deltafk); //la cantidad de elementos de gammaprima
  setlength(xa, lue); //este va a ser el nuevo x (adn)

  for j := 0 to lue-1 do
  begin
       acumR := 0.0;
       xa[j] := 0;

       for i:= 0 to N-1 do
       begin
            xr := Deltaxk[i];
            acumR := acumR + ((-Deltafk[i]/sqr(rk[i]))*xr[j])/S ;
       end;
       xa[j] := acumR+xAster.adn[j];
  end;

  //crear plan
  xp := TPlan.Create;
  for j := 0 to lue-1 do
  begin
     xp.adn[j] := xa[j];
  end;

  xp.raza:=472; //indica que este plan es de la raza gpa
  Result:= xp;

  //imprimir
  //writeln('idPlan=', xp.idPlan,'  x[0]=',xp.adn[0],'  x[1]=',xp.adn[1],'  f=',xp.fCriterio1);


  end;

end.

