//esta unit hace de base de datos (SQL) para hacer el módulo optimizador
//independiente de llevar cuenta de la base de datos de los planes, de esa
//forma la aplicación de prueba queda lo más parecida al caso real.
//M. Forets           @  iie    2011

unit dbPlanesPruebareductor;

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

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  xMatDefs, Math,
  uplan;

//devuelve todos los planes por orden de idPlan en orden creciente
function             returnAll: TDaOfTPlanPrueba;
//agrega un elemento (al final)
procedure            add(p: TPlan);
//al plan con identificador idPlan lo "actualiza" por el plan p
procedure            update(idPlan: Integer; p: TPlan);
//devuelve el plan con identificador idPlan
function             returnOne(idPlan: Integer): TPlan;
//devuelve los primeros NI individuos que surgen de ordenar la lista de planes de acuerdo a criterio
function             returnOrdList(NI: Integer; criterio: Integer): TDaOfTPlanPrueba;
//devuelve el tamaño de la poblacion (geneticos y gpa)
function             Poblacion_count: integer;
//devuelve el tamaño de la poblacion que son geneticos

//devuelve el tamaño de la poblacion que son gpa

//inicializa la base de datos en poblacion 0
procedure            InicializarDb;

//devuelve el plan con identificador idPlan que tiene determinado adn, o -1 si no existe dicho plan
function             returnOneIdPlanByAdn(adn: TDAOfNReal): Integer;
//devuelve el próximo id plan no utilizado
function              nextIdPlan(): Integer;
//devuelve true si adn1=adn2
function igualAdn(adn1, adn2: TDAOfNReal): Boolean;

//para debug: imprimie lista de idPlanes
procedure               imprimiListaDeIdPlanes;

//devuelve TRUE si el plan p existe (mismo adn)
function existePlan(p: TPlan): boolean;


implementation
//la base de datos de los planes evaluados hasta el momento
var
   todosLosPlanes     :     TDAOfTPlanPrueba;

procedure InicializarDb;
begin
     setlength(todosLosPlanes,0);
end;

function Poblacion_count: integer;
begin
     Result:=length(todosLosPlanes);
end;

function returnAll: TDAOfTPlanPrueba;
var
  i, j:             Integer;
  idPlan:           Integer;
  pL:               TDAOfTPlanPrueba;
  auxP:             TPlan;
begin
     //ordenar planes de acuerdo a idPlan
     //ordenamiento burbuja
     setlength(pl, length(todosLosPlanes));
     pL:=todosLosPlanes;
     idPlan:=pL[0].idPlan;
     for i:= 0 to length(todosLosPlanes)-2 do
     for j:= i+1 to length(todosLosPlanes)-1 do
     begin
          if (pL[j].idPlan < pL[i].idPlan) then
          begin
            //swap
            auxP := pL[i];
            pL[i]:=pL[j];
            pL[j]:=auxP;
          end;
     end;

     Result:= pL;
end;

procedure add(p: TPlan);
var
   auxTodosLosPlanes:            TDaOfTPlanPrueba;
   i:                            Integer;
   Noriginal:                    Integer;
begin
     NOriginal:=length(todosLosPlanes);
     setlength(auxTodosLosPlanes, NOriginal+1);
     //copiar del todosLosPlanes al auxiliar los primeros N elementos
     for i:= 0 to NOriginal-1 do
     begin
          auxTodosLosPlanes[i] := todosLosPlanes[i];
     end;
     auxTodosLosPlanes[NOriginal]:=p;
     //formatear el todosLosPlanes y copiarle todo
     setlength(todosLosPlanes,0);
     setlength(todosLosPlanes,NOriginal+1);
     for i:= 0 to NOriginal do
     begin
          todosLosPlanes[i] := auxTodosLosPlanes[i];
     end;
     //liberar aux
     setlength(auxTodosLosPlanes, 0);
     //obs: alternativo a lo anterior podría poner simplemente: todosLosPlanes:=auxTodosLosPlanes;
end;

procedure update(idPlan: Integer; p: TPlan);
var
   encontre: boolean;
   i:Integer;
begin
     i:=-1;
     encontre:=FALSE;
     while (not encontre) and (i < length(todosLosPlanes)-1) do
     begin
          i:=i+1;
          encontre := (todosLosPlanes[i].idPlan = p.idPlan);
     end;
     todosLosPlanes[i]:=p; //se supone que al plan que me pasan como parámetro ya le sumaron el cnt_evaluaciones

end;

function returnOne(idPlan: Integer): TPlan;
var
   encontre: boolean;
   i:Integer;
begin
     i:=-1;
     encontre:=FALSE;
     while (not encontre) and (i<length(todosLosPlanes)-1) do
     begin
          i:=i+1;
          encontre:=(todosLosPlanes[i].idPlan = idPlan);
     end;
     if (not encontre) then
     begin
        writeln('error en returnOne: plan no encontrado');
        //stop o algo.
     end
     else
         Result:=todosLosPlanes[i];
end;

function returnOrdList(NI: Integer; criterio: Integer): TDaOfTPlanPrueba;
var
   ptodosAux: TDAOfTPlanPrueba;
   auxP:      TPlan;
   listaNI:   TDAOfTPlanPrueba;
   i,j:       Integer;
begin
     //distintos "criterios" no están incoroporados en la clase TPlan,
     //ignoro criterio y ordeno por fCriterio1. Devuelvo en orden creciente de fCriterio1
     //los primeros NI elementos de la base de datos

     //primero ordeno todos los planes de acuerdo a criterio
     setlength(ptodosAux,length(todosLosPlanes));
     ptodosAux := todosLosPlanes;

     for i := 0   to length(ptodosAux)-2 do
     for j := i+1 to length(ptodosAux)-1 do
     begin
          if (ptodosAux[j].fCriterio1 < ptodosAux[i].fCriterio1) then
          begin
            //swap
            auxP := ptodosAux[i];
            ptodosAux[i]:=ptodosAux[j];
            ptodosAux[j]:=auxP;
          end;
     end;

     //devuelvo los primeros NI elementos
     setlength(listaNI, NI);
     for i:=0 to NI-1 do
     begin
          listaNI[i]:=ptodosAux[i];
     end;
     setlength(ptodosAux, 0);
     Result:=listaNI;
end;

function returnOneIdPlanByAdn(adn: TDAOfNReal): Integer;
var
   i: Integer;
   encontre: Boolean;
begin
     encontre:=FALSE;
     i:=-1;
     while (not encontre) and (i<length(todosLosPlanes)-1) do
     begin
          i:=i+1;
          encontre:= igualAdn(todosLosPlanes[i].adn,adn);
     end;




     if (not encontre) then
        Result:=-1
     else
         Result:=todosLosPlanes[i].idPlan;
end;

function nextIdPlan(): Integer;
var
   todosAux: TDAOfTPlanPrueba;
   nId:      Integer;
begin
     if (Poblacion_Count = 0) then
        Result:=1
     else
         begin
           setlength(todosAux, length(todosLosPlanes));

           todosAux:=returnAll;
           nId := todosAux[length(todosAux)-1].idPlan + 1;
           setlength(todosAux, 0);
           Result := nId;
         end;

end;

function igualAdn(adn1, adn2: TDaOFNReal): Boolean;
var
   iguales: Boolean;
   i:       Integer;
begin
     iguales:=TRUE;
     i:=-1;
     while (iguales) and (i<length(adn1)-1) do
     begin
          i := i+1;
          iguales:= ( adn1[i] = adn2[i]);
     end;
     Result := iguales;

end;

procedure               imprimiListaDeIdPlanes;
var
   i:                   Integer;
   arrPlanes:           TDAOfTPlanPrueba;
begin
     writeln('.....imprimiendo lista de planes ordenados por criterio....');
     setlength(arrPlanes, length(todosLosPlanes));
     arrPlanes := returnOrdList(Poblacion_Count, 0);
     for i:= 0 to Poblacion_Count-1 do
         writeln('idPlan=', todosLosPlanes[i].idPlan,'  x[0]=',todosLosPlanes[i].adn[0],'  x[1]=',todosLosPlanes[i].adn[1],'  f=',todosLosPlanes[i].fCriterio1);

end;

function existePlan(p: TPlan): boolean;
var
   id : integer;

begin
  Result := false;
  if (p.idPlan > 0) then
     Result := true
  else begin //para saber si existe tengo que buscar a otro individuo con el mismo adn
     id:=dbPlanesPruebaReductor.returnOneIdPlanByAdn(p.adn);
     if (id > -1) then
       Result:= true;
  end;

end;



end.

