Анализатор формул (с Delphi на C#)

function Recogn(st: String; var Num: Extended): Boolean;
const
  pogr = 1E-50;
var
  p, p1: Integer;
  i, j: Integer;
  v1, v2: Extended;
  func: (fNone, fSin, fCos, fTg, fCtg, fSh, fCh, fTh, fCth, fArcsin, fArccos,
         fArctg, fArcctg, fArsh, fArch, fArth, fArcth, fAbs, fLn, fLg, flog, fExp);
  Sign: Integer;
  s: String;
  s1: String;
 
function FindLeftValue(p: Integer; var Margin: Integer; var Value: Extended): Boolean;
var
  i: Integer;
begin
  i := p - 1;
  repeat
    i := i - 1
  until
    (i <= 0) or (s[i] = '#');
  Margin := i;
  try
    Value := StrToFloat(copy(s, i + 1, p - i - 2));
    Result := True;
  except
    Result := False
  end;
  delete(s, i, p - i);
end;
 
function FindRightValue(p: Integer; var Value: Extended): Boolean;
var
  i: Integer;
begin
  i := p + 1;
  repeat
    i := i + 1
  until
    (i > Length(s)) or (s[i] = '#');
  i := i - 1;
  s1 := copy(s, p + 2, i - p - 1);
  Result := TextToFloat(PWideChar(s1), value, fvExtended);
  delete(s, p + 1, i - p + 1);
end;
 
procedure PutValue(p: Integer; NewValue: Extended);
begin
  insert('#' + FloatToStr(v1) + '#', s, p);
end;
 
begin
  Result := False;
  s := st;
 
  // ()
  p := pos('(', s);
  while p > 0 do
  begin
    i := p;
    j := 1;
    repeat
      i := i + 1;
      if s[i] = '(' then
        j := j + 1;
      if s[i] = ')' then
        j := j - 1;
    until
      (i > Length(s)) or (j <= 0);
    if i > Length(s) then
      s := s + ')';
    if Recogn(copy(s, p + 1, i - p - 1), v1) = False then
      Exit;
    delete(s, p, i - p + 1);
    PutValue(p, v1);
 
    p := pos('(', s);
  end;
 
  // sin, cos, tg, ctg, sh, ch, th, cth, arcsin, arccos, arctg, arcctg, arsh, arch,
  // arth, arcth, abs, ln, lg, log2, exp
  repeat
    func := fNone;
    p1 := pos('sin', s);
    if p1 > 0 then
      begin
        func := fSin;
        p := p1;
      end;
    p1 := pos('cos', s);
    if p1 > 0 then
      begin
        func := fCos;
        p := p1;
      end;
    p1 := pos('tg', s);
    if p1 > 0 then
      begin
        func := fTg;
        p := p1;
      end;
    p1 := pos('ctg', s);
    if p1 > 0 then
      begin
        func := fCtg;
        p := p1;
      end;
    p1 := pos('sh', s);
    if p1 > 0 then
      begin
        func := fSh;
        p := p1;
      end;
    p1 := pos('ch', s);
    if p1 > 0 then
      begin
        func := fCh;
        p := p1;
      end;
    p1 := pos('th', s);
    if p1 > 0 then
      begin
        func := fTh;
        p := p1;
      end;
    p1 := pos('cth', s);
    if p1 > 0 then
      begin
        func := fCth;
        p := p1;
      end;
    p1 := pos('arcsin', s);
    if p1 > 0 then
      begin
        func := fArcsin;
        p := p1;
      end;
    p1 := pos('arccos', s);
    if p1 > 0 then
      begin
        func := fArccos;
        p := p1;
      end;
    p1 := pos('arctg', s);
    if p1 > 0 then
      begin
        func := fArctg;
        p := p1;
      end;
    p1 := pos('arcctg', s);
    if p1 > 0 then
      begin
        func := fArcctg;
        p := p1;
      end;
    p1 := pos('arsh', s);
    if p1 > 0 then
      begin
        func := fArsh;
        p := p1;
      end;
    p1 := pos('arch', s);
    if p1 > 0 then
      begin
        func := fArch;
        p := p1;
      end;
    p1 := pos('arth', s);
    if p1 > 0 then
      begin
        func := fArth;
        p := p1;
      end;
    p1 := pos('arcth', s);
    if p1 > 0 then
      begin
        func := fArcth;
        p := p1;
      end;
    p1 := pos('abs', s);
    if p1 > 0 then
      begin
        func := fAbs;
        p := p1;
      end;
    p1 := pos('ln', s);
    if p1 > 0 then
      begin
        func := fLn;
        p := p1;
      end;
    p1 := pos('lg', s);
    if p1 > 0 then
      begin
        func := fLg;
        p := p1;
      end;
    p1 := pos('log', s);
    if p1 > 0 then
      begin
        func := flog;
        p := p1;
      end;
    p1 := pos('e', s);
    if p1 > 0 then
      begin
        func := fExp;
        p := p1;
      end;
    if func = fNone then
      break;
 
    case func of
      fExp: i := p;
      fSh, fCh, fTh: i := p + 1;
      fSin, fCos, fCtg, fAbs, flog, fCth: i := p + 2;
      fArsh, fArch, fArth: i := p + 3;
      fArctg, fArcth: i := p + 4;
      fArcsin, fArccos, fArcctg: i := p + 5;
    else
      i := p + 1;
    end;
 
    if FindRightValue(i, v1) = false then
      Exit;
    delete(s, p, i - p + 1);
    case func of
      fSin: v1 := sin(v1);
      fCos: v1 := cos(v1);
      fTg:
      begin
        if abs(cos(v1)) < pogr then
          Exit;
        v1 := sin(v1) / cos(v1);
      end;
      fCtg:
      begin
        if abs(sin(v1)) < pogr then
          Exit;
        v1 := cos(v1) / sin(v1);
      end;
      fSh: v1 := (exp(v1) - exp(-v1)) / 2;
      fCh: v1 := (exp(v1) + exp(-v1)) / 2;
      fTh: v1 := (exp(2 * v1) - 1) / (exp(2 * v1) + 1);
      fCth: v1 := (exp(2 * v1) + 1) / (exp(2 * v1) - 1);
      fArcsin:
      begin
        if Abs(v1) > 1 then
          Exit;
        v1 := arcsin(v1);
      end;
      fArccos:
      begin
        if abs(v1) > 1 then
          Exit;
        v1 := arccos(v1);
      end;
      fArctg: v1 := arctan(v1);
      fArcctg: v1 := Pi / 2 - arctan(v1);
      fArsh: v1 := ln(v1 + sqrt(v1 * v1 + 1));
      fArch:
      begin
        if v1 < 1 then
          Exit;
        v1 := ln(v1 + sqrt(v1 * v1 - 1));
      end;
      fArth:
      begin
        if (((1 + v1) <= 0) or ((1 - v1) <= 0)) then
          Exit;
        v1 := 0.5 * ln((1 + v1) / (1 - v1));
      end;
      fArcth:
      begin
        if (((v1 + 1) <= 0) or ((v1 - 1) <= 0)) then
          Exit;
        v1 := 0.5 * ln((v1 + 1) / (v1 - 1));
      end;
      fAbs: v1 := abs(v1);
      fLn:
      begin
        if v1 < pogr then
          Exit;
        v1 := Ln(v1);
      end;
      fLg:
      begin
        if v1 < pogr then
          Exit;
        v1 := Log10(v1);
      end;
      fLog:
      begin
        if v1 < pogr then
          Exit;
        v1 := Log2(v1);
      end;
      fExp: v1 := exp(v1);
    end;
    PutValue(p, v1);
  until
    func = fNone;
 
  // power
  p := pos('^', s);
  while p > 0 do
  begin
    if FindRightValue(p, v2) = False then
      Exit;
    if FindLeftValue(p, i, v1) = False then
      Exit;
    if (v1 < 0) and (abs(Frac(v2)) > pogr) then
      Exit;
    if (abs(v1) < pogr) and (v2 < 0) then
      Exit;
    delete(s, i, 1);
    v1 := Power(v1, v2);
    PutValue(i, v1);
    p := pos('^', s);
  end;
 
  // *, /
  p := pos('*', s);
  p1 := pos('/', s);
  if (p1 > 0) and ((p1 < p) or (p <= 0)) then
    p := p1;
  while p > 0 do
  begin
    if FindRightValue(p, v2) = False then
      Exit;
    if FindLeftValue(p, i, v1) = False then
      Exit;
    if s[i] = '*' then
      v1 := v1 * v2
    else
      begin
        if abs(v2) < pogr then
          Exit;
        v1 := v1 / v2;
      end;
    delete(s, i, 1);
    PutValue(i, v1);
 
    p := pos('*', s);
    p1 := pos('/', s);
    if (p1 > 0) and ((p1 < p) or (p <= 0)) then
      p := p1;
  end;
 
  // +, -
  Num := 0;
  repeat
    Sign := 1;
    while (Length(s) > 0) and (s[1] <> '#') do
      begin
        if s[1] = '-' then
          Sign := -Sign
        else
          if s[1] <> '+' then
            Exit;
        delete(s, 1, 1);
      end;
    if FindRightValue(0, v1) = false then
      Exit;
    if Sign < 0 then
      Num := Num - v1
    else
      Num := Num + v1;
  until
    Length(s) <= 0;
 
  Result := true;
end;