unit uoperadoresbinomicosbasicos;

interface

uses
  Classes, SysUtils, math, uparseadorsupersimple;


procedure AgregarOperadoresBinomicos( Evaluador: TEvaluadorExpresionesSimples );


type
   { TOperSuma_F_FF }
   TOperSuma_F_FF = class(   TOperProcDef_ )
    procedure evaluar( salida: TExpresion; entradas: TExprLst ); override;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable: TNodoToken; parametros: TExprLst): TExpresion;
      override;
    {$ENDIF}
    constructor Create;
  end;

   { TOperResta_F_FF }
   TOperResta_F_FF = class(   TOperProcDef_ )
    procedure evaluar( salida: TExpresion; entradas: TExprLst ); override;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable: TNodoToken; parametros: TExprLst): TExpresion;
      override;
    {$ENDIF}
    constructor Create;
  end;

   { TOperProducto_F_FF }
   TOperProducto_F_FF = class(   TOperProcDef_ )
    procedure evaluar( salida: TExpresion; entradas: TExprLst ); override;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable: TNodoToken; parametros: TExprLst): TExpresion;
      override;
    {$ENDIF}
    constructor Create;
  end;

   { TOperDivision_F_FF }
   TOperDivision_F_FF = class(   TOperProcDef_ )
    procedure evaluar( salida: TExpresion; entradas: TExprLst ); override;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable: TNodoToken; parametros: TExprLst): TExpresion;
      override;
    {$ENDIF}
    constructor Create;
  end;


   { TOperPower_F_FF }
   TOperPower_F_FF = class(   TOperProcDef_ )
    procedure evaluar( salida: TExpresion; entradas: TExprLst ); override;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable: TNodoToken; parametros: TExprLst): TExpresion;
      override;
    {$ENDIF}
    constructor Create;
  end;


  { TOperAsignar := }
  TOperAsignar = class(   TOperProcDef_ )
    procedure evaluar( salida: TExpresion; entradas: TExprLst ); override;
    procedure MarcarVariablesAsignadas( salida: TExpresion; entradas: TExprLst );
    constructor Create;
  end;


implementation

uses
  ufuncionesbasicas;

// Suma
procedure TOperSuma_F_FF.evaluar(salida: TExpresion; entradas: TExprLst);
var
  res, parA, parB: TExpresion;
begin
  entradas.evaluar;
  res:= salida;
  parA:= entradas[0];
  parB:= entradas[1];

  res.val.val_F:= parA.ValAsFloat + parB.ValAsFloat;
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperSuma_F_FF.crearDerivada(variable: TNodoToken; parametros: TExprLst
  ): TExpresion;
var
  parA, parB, dParA, dParB: TExpresion;
  aPrimaMasBPrima_lst: TExprLst;
  aPrimaMasBPrima_oper: TOperProc;
begin

  ///////  (A + B)' = A' + B'  //////

  parA:= parametros[0]; // A
  dParA:=parA.crearDerivada(variable); // A'
  parB:= parametros[1]; // B
  dParB:=parB.crearDerivada(variable); // B'

  // A' + B' //
  aPrimaMasBPrima_lst:=TExprLst.Create;
  aPrimaMasBPrima_lst.add(dParA);
  aPrimaMasBPrima_lst.add(dParB);
  lst_opers.add(TOperSuma_F_FF.Create);
  aPrimaMasBPrima_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],aPrimaMasBPrima_lst);

  Result:=aPrimaMasBPrima_oper;

end;
{$ENDIF}


constructor TOperSuma_F_FF.Create;
begin
  inherited Create( '+', 'F', 'FF' );
end;

// Resta
procedure TOperResta_F_FF.evaluar(salida: TExpresion; entradas: TExprLst);
var
  res, parA, parB: TExpresion;
begin
  entradas.evaluar;
  res:= salida;
  parA:= entradas[0];
  parB:= entradas[1];
  res.val.val_F:= parA.ValAsFloat - parB.ValAsFloat;
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperResta_F_FF.crearDerivada(variable: TNodoToken;
  parametros: TExprLst): TExpresion;
var
  parA, parB, dParA, dParB: TExpresion;
  aPrimaMenosBPrima_lst: TExprLst;
  aPrimaMenosBPrima_oper: TOperProc;
begin

  ///////  (A - B)' = A' - B'  //////

  parA:= parametros[0]; // A
  dParA:=parA.crearDerivada(variable); // A'
  parB:= parametros[1]; // B
  dParB:=parB.crearDerivada(variable); // B'

  // A' - B' //
  aPrimaMenosBPrima_lst:=TExprLst.Create;
  aPrimaMenosBPrima_lst.add(dParA);
  aPrimaMenosBPrima_lst.add(dParB);
  lst_opers.add(TOperResta_F_FF.Create);
  aPrimaMenosBPrima_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],aPrimaMenosBPrima_lst);

  Result:=aPrimaMenosBPrima_oper;

end;
{$ENDIF}

constructor TOperResta_F_FF.Create;
begin
  inherited Create( '-', 'F', 'FF' );
end;


// Producto
procedure TOperProducto_F_FF.evaluar(salida: TExpresion; entradas: TExprLst);
var
  res, parA, parB: TExpresion;
begin
  entradas.evaluar;
  res:= salida;
  parA:= entradas[0];
  parB:= entradas[1];
  res.val.val_F:= parA.ValAsFloat * parB.ValAsFloat;
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperProducto_F_FF.crearDerivada(variable: TNodoToken;
  parametros: TExprLst): TExpresion;
var
  parA, dParA, parB, dParB: TExpresion;
  aPrimaPorB_lst, bPrimaPorA_lst, aPrimaPorBMasBPrimaPorA_lst: TExprLst;
  aPrimaPorB_oper, bPrimaPorA_oper, aPrimaPorBMasBPrimaPorA_oper: TOperProc;

begin

  ///////  (A*B)' = A'*B + B'*A  //////
  parA:= parametros[0]; // A
  dParA:=parA.crearDerivada(variable); // A'
  parB:= parametros[1]; // B
  dParB:=parB.crearDerivada(variable); // B'

  // A'*B //
  aPrimaPorB_lst:=TExprLst.Create;
  aPrimaPorB_lst.add(dParA);
  aPrimaPorB_lst.add(parB.crearClon);
  lst_opers.add(TOperProducto_F_FF.Create);
  aPrimaPorB_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],aPrimaPorB_lst);

  // B'* A //
  bPrimaPorA_lst:=TExprLst.Create;
  bPrimaPorA_lst.add(parA.crearClon);
  bPrimaPorA_lst.add(dParB);
  lst_opers.add(TOperProducto_F_FF.Create);
  bPrimaPorA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],bPrimaPorA_lst);

  // A'*B + B'*A //
  aPrimaPorBMasBPrimaPorA_lst:=TExprLst.Create;
  aPrimaPorBMasBPrimaPorA_lst.add(aPrimaPorB_oper);
  aPrimaPorBMasBPrimaPorA_lst.add(bPrimaPorA_oper);
  lst_opers.add(TOperSuma_F_FF.Create);
  aPrimaPorBMasBPrimaPorA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],
    aPrimaPorBMasBPrimaPorA_lst);

  Result:=aPrimaPorBMasBPrimaPorA_oper;
end;
{$ENDIF}


constructor TOperProducto_F_FF.Create;
begin
  inherited Create( '*', 'F', 'FF' );
end;


// Division
procedure TOperDivision_F_FF.evaluar(salida: TExpresion; entradas: TExprLst);
var
  res, parA, parB: TExpresion;
begin
  entradas.evaluar;
  res:= salida;
  parA:= entradas[0];
  parB:= entradas[1];
  res.val.val_F:= parA.ValAsFloat / parB.ValAsFloat;
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperDivision_F_FF.crearDerivada(variable: TNodoToken;
  parametros: TExprLst): TExpresion;
var
  parA, dParA, parB, dParB: TExpresion;
  dos: TConst_I;
  aPrimaPorB_lst, bPrimaPorA_lst, aPrimaPorBMenosBPrimaPorA_lst,
    bAlCuadrado_lst, aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_lst: TExprLst;
  aPrimaPorB_oper, bPrimaPorA_oper, aPrimaPorBMenosBPrimaPorA_oper,
    bAlCuadrado_oper, aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_oper: TOperProc;

begin

  ///////  (A/B)' = (A'*B - B'*A)/B^2  //////

  parA:= parametros[0]; // A
  dParA:=parA.crearDerivada(variable); // A'
  parB:= parametros[1]; // B
  dParB:=parB.crearDerivada(variable); // B'
  dos:=TConst_I.Create(2); // 2

  // A'*B //
  aPrimaPorB_lst:=TExprLst.Create;
  aPrimaPorB_lst.add(dParA);
  aPrimaPorB_lst.add(parB.crearClon);
  lst_opers.add(TOperProducto_F_FF.Create);
  aPrimaPorB_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],
    aPrimaPorB_lst);

  // B'* A //
  bPrimaPorA_lst:=TExprLst.Create;
  bPrimaPorA_lst.add(parA.crearClon);
  bPrimaPorA_lst.add(dParB);
  lst_opers.add(TOperProducto_F_FF.Create);
  bPrimaPorA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],
    bPrimaPorA_lst);

  // A'*B - B'*A //
  aPrimaPorBMenosBPrimaPorA_lst:=TExprLst.Create;
  aPrimaPorBMenosBPrimaPorA_lst.add(aPrimaPorB_oper);
  aPrimaPorBMenosBPrimaPorA_lst.add(bPrimaPorA_oper);
  lst_opers.add(TOperResta_F_FF.Create);
  aPrimaPorBMenosBPrimaPorA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],
    aPrimaPorBMenosBPrimaPorA_lst);

  // B^2 //
  bAlCuadrado_lst:=TExprLst.Create;
  bAlCuadrado_lst.add(parB.crearClon);
  bAlCuadrado_lst.add(dos);
  lst_opers.add(TOperPower_F_FF.Create);
  bAlCuadrado_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],bAlCuadrado_lst);

  // (A'*B - B'*A)/B^2 //
  aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_lst:=TExprLst.Create;
  aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_lst.add(aPrimaPorBMenosBPrimaPorA_oper);
  aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_lst.add(bAlCuadrado_oper);
  lst_opers.add(TOperDivision_F_FF.Create);
  aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_oper:=TOperProc.Create(
    lst_opers[lst_opers.Count - 1],aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_lst);

  Result:=aPrimaPorBMenosBPrimaPorASobreBAlCuadrado_oper;

end;
{$ENDIF}

constructor TOperDivision_F_FF.Create;
begin
  inherited Create( '/', 'F', 'FF' );
end;



// Power
procedure TOperPower_F_FF.evaluar(salida: TExpresion; entradas: TExprLst);
var
  res, parA, parB: TExpresion;
begin
  entradas.evaluar;
  res:= salida;
  parA:= entradas[0];
  parB:= entradas[1];

  res.val.val_F:= power( parA.ValAsFloat, parB.ValAsFloat );
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperPower_F_FF.crearDerivada(variable: TNodoToken;
  parametros: TExprLst): TExpresion;
var
  parA, dParA, parB, dParB, uno: TExpresion;
  LogNepA_lst, BMenosUno_lst, AAlaBMenosUno_lst, BPorAPrima_lst,
    APorBPrima_lst, APorBPrimaPorLNA_lst,
    BPorAPrimaMasAPorBPrimaPorLNA_lst,
    AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_lst: TExprLst;
  BMenosUno_oper, AAlaBMenosUno_oper, BPorAPrima_oper,
    APorBPrima_oper, APorBPrimaPorLNA_oper,
    BPorAPrimaMasAPorBPrimaPorLNA_oper, LogNepA_oper,
    AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_oper: TOperProc;
begin

  ///////  (A^B)' = A^(B-1)*(B*A'+A*B'*LN(A))  //////

  parA:= parametros[0]; // A
  dParA:=parA.crearDerivada(variable); // A'
  parB:= parametros[1]; // B
  dParB:=parB.crearDerivada(variable); // B'
  uno:=TConst_I.Create(1); // 1

  // LN(A) //
  LogNepA_lst:=TExprLst.Create;
  LogNepA_lst.add(parA.crearClon);
  lst_opers.add(TFuncLn_F_F.Create);
  LogNepA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],LogNepA_lst);

  // (B-1) //
  BMenosUno_lst:=TExprLst.Create;
  BMenosUno_lst.add(parB.crearClon);
  BMenosUno_lst.add(uno);
  lst_opers.add(TOperResta_F_FF.Create);
  BMenosUno_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],BMenosUno_lst);

  // A^(B-1) //
  AAlaBMenosUno_lst:=TExprLst.Create;
  AAlaBMenosUno_lst.add(parA.crearClon);
  AAlaBMenosUno_lst.add(BMenosUno_oper);
  lst_opers.add(TOperPower_F_FF.Create);
  AAlaBMenosUno_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],AAlaBMenosUno_lst);

  // B*A' //
  BPorAPrima_lst:=TExprLst.Create;
  BPorAPrima_lst.add(parB.crearClon);
  BPorAPrima_lst.add(dParA);
  lst_opers.add(TOperProducto_F_FF.Create);
  BPorAPrima_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],BPorAPrima_lst);

  // A*B' //
  APorBPrima_lst:=TExprLst.Create;
  APorBPrima_lst.add(parA.crearClon);
  APorBPrima_lst.add(dParB);
  lst_opers.add(TOperProducto_F_FF.Create);
  APorBPrima_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],APorBPrima_lst);

  // A*B'*LN(A) //
  APorBPrimaPorLNA_lst:=TExprLst.Create;
  APorBPrimaPorLNA_lst.add(APorBPrima_oper);
  APorBPrimaPorLNA_lst.add(LogNepA_oper);
  lst_opers.add(TOperProducto_F_FF.Create);
  APorBPrimaPorLNA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],APorBPrimaPorLNA_lst);

  // B*A'+A*B'*LN(A) //
  BPorAPrimaMasAPorBPrimaPorLNA_lst:=TExprLst.Create;
  BPorAPrimaMasAPorBPrimaPorLNA_lst.add(BPorAPrima_oper);
  BPorAPrimaMasAPorBPrimaPorLNA_lst.add(APorBPrimaPorLNA_oper);
  lst_opers.add(TOperSuma_F_FF.Create);
  BPorAPrimaMasAPorBPrimaPorLNA_oper:=TOperProc.Create(lst_opers[lst_opers.Count - 1],
    BPorAPrimaMasAPorBPrimaPorLNA_lst);

  // A^(B-1)*(B*A'+A*B'*LN(A)) //

  AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_lst:=TExprLst.Create;
  AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_lst.add(AAlaBMenosUno_oper);
  AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_lst.add(BPorAPrimaMasAPorBPrimaPorLNA_oper);
  lst_opers.add(TOperProducto_F_FF.Create);
  AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_oper:=TOperProc.Create(
    lst_opers[lst_opers.Count - 1], AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_lst);

  Result:=AAlaBMenosUnoPorBPorAPrimaMasAPorBPrimaPorLNA_oper;

end;
{$ENDIF}

constructor TOperPower_F_FF.Create;
begin
  inherited Create( '^', 'F', 'FF' );
end;


procedure TOperAsignar.MarcarVariablesAsignadas( salida: TExpresion; entradas: TExprLst );
var
  parA, parB: TExpresion;
  al, bl, rl: TExprLst;
  k: integer;

begin
  parA:= entradas[0];
  parB:= entradas[1];

  if parA is TExprLst then
  begin
     if  not ( parB is TExprLst ) then raise Exception.Create('Intento de asignar un elemento a una lista de saldia');
     al:= parA as TExprLst;
     for k:= 0 to al.lst.count -1 do
     begin
       parA:= al[k];
       (parA as TVar ).flg_asignada:= true;
     end;
  end
  else
  begin
    ( parA as TVar ).flg_asignada:= true;
  end;
end;


procedure TOperAsignar.evaluar( salida: TExpresion; entradas: TExprLst );
var
  res, parA, parB: TExpresion;
  al, bl, rl: TExprLst;
  k: integer;

begin
  entradas.evaluar;

  res:= salida;
  parA:= entradas[0];
  parB:= entradas[1];

  if parA is TExprLst then
  begin
     if  not ( parB is TExprLst ) then raise Exception.Create('Intento de asignar un elemento a una lista de saldia');
     al:= parA as TExprLst;
     bl:= parB as TExprLst;
     rl:= res as TExprLst;
     for k:= 0 to al.lst.count -1 do
     begin
       parA:= al[k];
       parB:= bl[k];
       res:= rl[k];
       parA.val:= parB.val;
       res.val:= parB.val;
     end;
  end
  else
  begin
    parA.val:= parB.val;
    res.val:= parB.val;
  end;
end;

constructor TOperAsignar.Create;
begin
  inherited Create( ':=', 'X', 'XX' );
end;


procedure AgregarOperadoresBinomicos( Evaluador: TEvaluadorExpresionesSimples );
var
  aDef: TOperProcDef_;
begin
  aDef:= TOperSuma_F_FF.Create;
  Evaluador.CatalogoOperadoresBinomicos.add( aDef );
  aDef:= TOperResta_F_FF.Create;
  Evaluador.CatalogoOperadoresBinomicos.add( aDef );
  aDef:= TOperProducto_F_FF.Create;
  Evaluador.CatalogoOperadoresBinomicos.add( aDef );
  aDef:= TOperDivision_F_FF.Create;
  Evaluador.CatalogoOperadoresBinomicos.add( aDef );

  aDef:= TOperPower_F_FF.Create;
  Evaluador.CatalogoOperadoresBinomicos.add( aDef );

  aDef:= TOperAsignar.Create;
  Evaluador.CatalogoOperadoresBinomicos.add( aDef );
end;

end.

