Code:

unit Recognition;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Math;

type

TVar = set of char;

procedure Preparation(var s: String; variables: TVar);

function ChangeVar(s: String; c: char; value: extended): String;

function Recogn(st: String; var Num: extended): boolean;

implementation

procedure Preparation(var s: String; variables: TVar);

const

operators: set of char = ['+','-','*', '/', '^'];

var

i: integer;

figures: set of char;

begin

figures := ['0','1','2','3','4','5','6','7','8','9', DecimalSeparator] + variables;

// " "

repeat

   i := pos(' ', s);

   if i <= 0 then break;

   delete(s, i, 1);

until 1 = 0;

s := LowerCase(s);

// ".", ","

if DecimalSeparator = '.' then begin

   i := pos(',', s);

   while i > 0 do begin

     s[i] := '.';

     i := pos(',', s);

   end;

end else begin

   i := pos('.', s);

   while i > 0 do begin

     s[i] := ',';

     i := pos('.', s);

   end;

end;

// Pi

repeat

   i := pos('pi', s);

   if i <= 0 then break;

   delete(s, i, 2);

   insert(FloatToStr(Pi), s, i);

until 1 = 0;

// ":"

repeat

   i := pos(':', s);

   if i <= 0 then break;

   s[i] := '/';

until 1 = 0;

// |...|

repeat

   i := pos('|', s);

   if i <= 0 then break;

   s[i] := 'a';

   insert('bs(', s, i + 1);

   i := i + 3;

   repeat i := i + 1 until (i > Length(s)) or (s[i] = '|');

   if s[i] = '|' then s[i] := ')';

until 1 = 0;

// #...#

i := 1;

repeat

   if s[i] in figures then begin

     insert('#', s, i);

     i := i + 2;

     while (s[i] in figures) do i := i + 1;

     insert('#', s, i);

     i := i + 1;

   end;

   i := i + 1;

until i > Length(s);

end;

function ChangeVar(s: string; c: char; value: extended): String;

var

p: integer;

begin

result := s;

repeat

   p := pos(c, result);

   if p <= 0 then break;

   delete(result, p, 1);

   insert(FloatToStr(value), result, p);

until false;

end;

function Recogn(st: String; var num: extended): boolean;

const

pogr = 1E-10;

var

p, p1: integer;

i, j: integer;

v1, v2: extended;

func: (fNone, fSin, fCos, fTg, fCtg, fArcsin, fArccos, fArctg, fAbs, fLn, fLg, 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(PChar(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, arcsin, arccos, arctg, abs, ln, lg, log, 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('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('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('exp', s);

   if p1 > 0 then begin

     func := fExp;

     p := p1;

   end;

   if func = fNone then break;

   case func of

     fSin, fCos, fCtg, fAbs, fExp: i := p + 2;

     fArctg: i := p + 4;

     fArcsin, fArccos: 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;

     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);

     fAbs: v1 := abs(v1);

     fLn: begin

       if v1 < pogr then Exit;

       v1 := Ln(v1);

     end;

     fLg: begin

       if v1 < 0 then Exit;

       v1 := Log10(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;

end.