diffexpress.pas

delphi 計算用第三方 控件

function TDiffExpress.simplify(_t: integer): integer;
var 
  p1, p2: integer;
begin
  Result := 0;
  if _t = 0 then exit;
  case t[_t].num of
    3:
    begin
      t[_t].l := simplify(t[_t].l); 
      t[_t].r := simplify(t[_t].r);
      p1 := t[_t].l; 
      p2 := t[_t].r;
      if (t[p1].num = 7) and (t[p2].num = 7) then
      begin
        t[_t].num := 7; 
        t[_t].con := floattostr(strtofloat(t[p1].con) + strtofloat(t[p2].con));
        { t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      if (t[p1].num = 7) and (strtofloat(t[p1].con) = 0) then
      begin  {t[_t].l:=deltree(t[_t].l); }Result := t[_t].r;  
        exit;  
      end;
      if (t[p2].num = 7) and (strtofloat(t[p2].con) = 0) then
      begin { t[_t].r:=deltree(t[_t].r); }Result := t[_t].l;  
        exit;  
      end;
      Result := _t;
    end;
    4:
    begin
      t[_t].l := simplify(t[_t].l); 
      t[_t].r := simplify(t[_t].r);
      p1 := t[_t].l; 
      p2 := t[_t].r;
      if (t[p1].num = 7) and (t[p2].num = 7) then
      begin
        t[_t].num := 7; 
        t[_t].con := floattostr(strtofloat(t[p1].con) - strtofloat(t[p2].con));
        { t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r);} Result := _t; 
        exit;
      end;
      if (t[p1].num = 7) and (strtofloat(t[p1].con) = 0) then
      begin  
        t[_t].num := 9;
        //  deltree(t[_t].l);
        t[_t].l := t[_t].r;
        t[_t].r := 0;
        Result := _t;  
        exit;
      end;
      if (t[p2].num = 7) and (strtofloat(t[p2].con) = 0) then
      begin  { t[_t].r:=deltree(t[_t].r); }Result := t[_t].l;  
        exit;  
      end;
      Result := _t;
    end;
    5:
    begin
      t[_t].l := simplify(t[_t].l); 
      t[_t].r := simplify(t[_t].r);
      p1 := t[_t].l; 
      p2 := t[_t].r;
      if (t[p1].num = 7) and (t[p2].num = 7) then
      begin
        t[_t].num := 7; 
        t[_t].con := floattostr(strtofloat(t[p1].con) * strtofloat(t[p2].con));
        { t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      if ((t[p1].num = 7) and (strtofloat(t[p1].con) = 0)) or
        ((t[p2].num = 7) and (strtofloat(t[p2].con) = 0)) then
      begin  
        t[_t].con := '0'; 
        t[_t].num := 7;
        {  t[_t].l:=deltree(t[_t].l); .r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      if ((t[p1].num = 7) and (strtofloat(t[p1].con) = 1)) then
      begin
        {  t[_t].l:=deltree(t[_t].l); }Result := t[_t].r;  
        exit;
      end;
      if ((t[p2].num = 7) and (strtofloat(t[p2].con) = 1)) then
      begin
        {  t[_t].r:=deltree(t[_t].r); } Result := t[_t].l;  
        exit;
      end;
      Result := _t;
    end;
    6:
    begin
      t[_t].l := simplify(t[_t].l); 
      t[_t].r := simplify(t[_t].r);
      p1 := t[_t].l; 
      p2 := t[_t].r;
      if (t[p1].num = 7) and (t[p2].num = 7) then
      begin
        t[_t].num := 7; 
        t[_t].con := floattostr(strtofloat(t[p1].con) / strtofloat(t[p2].con));
        {  t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      if (t[p1].num = 7) and (strtofloat(t[p1].con) = 0) then
      begin  
        t[_t].con := '0'; 
        t[_t].num := 7;
        { t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      if (t[p2].num = 7) and (strtofloat(t[p2].con) = 0) then
      begin  
        Error('Dividion by zero.');  
      end;
      if ((t[p2].num = 7) and (strtofloat(t[p2].con) = 1)) then
      begin
        {  t[_t].r:=deltree(t[_t].r); }Result := t[_t].l;  
        exit;
      end;
      Result := _t;
    end;
    7: Result := _t;
    8: Result := _t;
    9:
    begin
      t[_t].l := simplify(t[_t].l);
      p1 := t[_t].l;
      if t[p1].num = 7 then
      begin  
        t[_t].num := 7; 
        t[_t].con := floattostr(-strtofloat(t[p1].con));
        {  t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      Result := _t;
    end;
    10..30:
    begin
      t[_t].l := simplify(t[_t].l);
      p1 := t[_t].l;
      if t[p1].num = 7 then
      begin
        case t[_t].num of
          10: t[_t].con := floattostr(cos(strtofloat(t[p1].con)));
          11: t[_t].con := floattostr(sin(strtofloat(t[p1].con)));
          12: t[_t].con := floattostr(sin(strtofloat(t[p1].con)) / cos(strtofloat(t[p1].con)));
          13: t[_t].con := floattostr(cos(strtofloat(t[p1].con)) / sin(strtofloat(t[p1].con)));
          14: t[_t].con := floattostr(abs(strtofloat(t[p1].con)));
          15: if strtofloat(t[p1].con) > 0 then t[_t].con := '1'
            else if strtofloat(t[p1].con) < 0 then t[_t].con := '-1'
            else 
              t[_t].con := '0';
          16: t[_t].con := floattostr(sqrt(strtofloat(t[p1].con)));
          17: t[_t].con := floattostr(ln(strtofloat(t[p1].con)));
          18: t[_t].con := floattostr(exp(strtofloat(t[p1].con)));
          19: t[_t].con := floattostr(arcsin(strtofloat(t[p1].con)));
          20: t[_t].con := floattostr(arccos(strtofloat(t[p1].con)));
          21: t[_t].con := floattostr(arctan(strtofloat(t[p1].con)));
          22: t[_t].con := floattostr(pi / 2 - arctan(strtofloat(t[p1].con)));
          23: t[_t].con := floattostr((exp(strtofloat(t[p1].con)) - exp(-strtofloat(t[p1].con))) /
              2);
          24: t[_t].con := floattostr((exp(strtofloat(t[p1].con)) + exp(-strtofloat(t[p1].con))) /
              2);
          25: t[_t].con := floattostr((exp(strtofloat(t[p1].con)) - exp(-strtofloat(t[p1].con))) /
              (exp(strtofloat(t[p1].con)) + exp(-strtofloat(t[p1].con))));
          26: t[_t].con := floattostr((exp(strtofloat(t[p1].con)) + exp(-strtofloat(t[p1].con))) /
              (exp(strtofloat(t[p1].con)) - exp(-strtofloat(t[p1].con))));
          27: if strtofloat(t[p1].con) >= 0 then  t[_t].con := '1'
            else 
              t[_t].con := '0';
        end;
        t[_t].num := 7;
        { t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end;
      Result := _t;
    end;
    31:
    begin
      t[_t].l := simplify(t[_t].l); 
      t[_t].r := simplify(t[_t].r);
      p1 := t[_t].l; 
      p2 := t[_t].r;
      if (t[p1].num = 7) and (strtofloat(t[p1].con) = 0) then
      begin  
        t[_t].num := 7; 
        t[_t].con := '0';
        {  t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r); }Result := _t; 
        exit;
      end 
      else if strtofloat(t[p2].con) = 0 then
      begin  
        t[_t].num := 7; 
        t[_t].con := '1';
        {  t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r);} Result := _t; 
        exit;
      end 
      else if t[p1].num = 7 then
      begin
        t[_t].num := 7;
        t[_t].con :=
          floattostr(exp(ln(abs(strtofloat(t[p1].con))) * strtofloat(t[p2].con)));
        if strtofloat(t[p1].con) < 0 then
        begin
          if round(strtofloat(t[p2].con) / 2) <> (strtofloat(t[p2].con) / 2) then
            t[_t].con := floattostr(-strtofloat(t[_t].con));
        end;
        {  t[_t].l:=deltree(t[_t].l); t[_t].r:=deltree(t[_t].r);} Result := _t; 
        exit;
      end;
      if strtofloat(t[p2].con) = 1 then
      begin
        {  t[_t].r:=deltree(t[_t].r);} Result := t[_t].l; 
        exit;
      end;
      Result := _t;
    end;
  end;
end;

//  Construction of simplified formula by tree

function TDiffExpress.getformula2(_t: integer): string;
var 
  p1, p2: PTree;
  s1, s2: string;
begin
  Result := '';
  if _t = 0 then exit;
  s1 := getformula2(t[_t].l); 
  s2 := getformula2(t[_t].r);
  p1 := t[_t].l; 
  p2 := t[_t].r;
  case t[_t].num of
    3: Result := s1 + '+' + s2;
    4: 
    begin
      if not (t[p2].num in [5,6,7,8,10..31]) then
        s2 := '(' + s2 + ')';
      Result := s1 + '-' + s2;
    end;
    5: 
    begin
      if not (t[p1].num in [5,6,7,8,10..31]) then
        s1 := '(' + s1 + ')';
      if not (t[p2].num in [5,6,7,8,10..31]) then
        s2 := '(' + s2 + ')';
      Result := s1 + '*' + s2;
    end;
    6: 
    begin
      if not (t[p1].num in [5,6,7,8,10..31]) then
        s1 := '(' + s1 + ')';
      if not (t[p2].num in [7,8,10..31]) then
        s2 := '(' + s2 + ')';
      Result := s1 + '/' + s2;
    end;
    7: 
    begin
      Result := t[_t].con;
      if strtofloat(t[_t].con) < 0 then Result := '(' + t[_t].con + ')';
    end;
    8: Result := t[_t].con;
    9: 
    begin
      if not (t[p1].num in [7,8,10..30]) then  s1 := '(' + s1 + ')';
      Result := '(-' + s1 + ')';
    end;
    10..30: Result := t[_t].con + '(' + s1 + ')';
    31: 
    begin
      p1 := t[_t].l;
      if not (t[p1].num in [7,8]) then
        s1 := '(' + s1 + ')';
      Result := s1 + '^' + s2;
    end;
  end;
end;
// Construcion of formula by tree

function TDiffExpress.getformula(_t: PTree): string;
begin
  Result := '';
  if _t = 0 then exit;
  case t[_t].num of
    3: Result := '((' + getformula(t[_t].l) + ')+(' + getformula(t[_t].r) + '))';
    4: Result := '((' + getformula(t[_t].l) + ')-(' + getformula(t[_t].r) + '))';
    5: Result := '((' + getformula(t[_t].l) + ')*(' + getformula(t[_t].r) + '))';
    6: Result := '((' + getformula(t[_t].l) + ')/(' + getformula(t[_t].r) + '))';
    7,8: Result := t[_t].con;
    9: Result := '(-(' + getformula(t[_t].l) + '))';
    10..30: Result := t[_t].con + '(' + getformula(t[_t].l) + ')';
    31: Result := '((' + getformula(t[_t].l) + ')^(' + getformula(t[_t].r) + '))';
  end;
end;

// Differentiaite expression

function TDiffExpress.diff(v: string): string;
  function df(_t: PTree): string;
  var 
    r: string;
  begin
    Result := '0';
    if _t = 0 then exit;
    case t[_t].num of
      3:
        Result := '((' + df(t[_t].l) + ')+(' + df(t[_t].r) + '))';
      4:
        Result := '((' + df(t[_t].l) + ')-(' + df(t[_t].r) + '))';
      5:
      begin
        r := '((' + df(t[_t].l) + ')*(' + getformula(t[_t].r) + ')+';
        r := r + '(' + df(t[_t].r) + ')*(' + getformula(t[_t].l) + '))';
        Result := r;
      end;
      6:
      begin
        r := '((' + df(t[_t].l) + ')*(' + getformula(t[_t].r) + ')-';
        r := r + '(' + df(t[_t].r) + ')*(' + getformula(t[_t].l) + '))';
        r := r + '/(' + getformula(t[_t].r) + ')^2';
        Result := r;
      end;
      7: Result := '0';
      8: if t[_t].con = DVar then  Result := '1';
      9: Result := '(-(' + df(t[_t].l) + '))';
      10: Result := '(-sin(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      11: Result := '(cos(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      12: Result := '(1/(cos(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      13: Result := '(-1/(sin(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      14: Result := '(sgn(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      15,27: Result := '0';
      16: Result := '(0.5/sqrt(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      17: Result := '(1/(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      18: Result := '(exp(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      19: Result := '(1/sqrt(1-(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      20: Result := '(-1/sqrt(1-(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      21: Result := '(1/(1+(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      22: Result := '(-1/(1+(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      23: Result := '(ch(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      24: Result := '(sh(' + getformula(t[_t].l) + ')*(' + df(t[_t].l) + '))';
      25: Result := '(1/(ch(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      26: Result := '(-1/(sh(' + getformula(t[_t].l) + ')^2)*(' + df(t[_t].l) + '))';
      31:
      begin
        r := '((' + getformula(t[_t].r) + ')*(' + getformula(t[_t].l) + ')^(';
        r := r + floattostr(strtofloat(getformula(t[_t].r)) - 1);
        Result := r + ')*(' + df(t[_t].l) + '))';
      end;
    end;
  end;

begin
  DVar := v;
  DelTree;
  Err := False;
  Prevlex := 0;
  Curlex := 0;
  Pos := 1;
  bc := 0;
  Tree := GetTree(Formula);
  if (bc <> 0) or Err then
  begin
    Tree := 0;
    Error('Error in formula.');
  end;

  Err := False;
  Prevlex := 0;
  Curlex := 0;
  Pos := 1;
  bc := 0;
  Tree2 := GetTree(df(Tree));
  if (bc <> 0) or Err then
  begin
    Tree2 := 0;
    Error('Error in formula.');
  end
  else
    Result := getformula2(simplify(Tree2));
  DelTree;
end;

end.