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.

uses Recognition;



procedure TForm1.Button1Click(Sender: TObject);

const

left = -10;

right = 10;

YScale = 50;

k = 10;

var

i: integer;

Num: extended;

s: String;

XScale: single;

col: TColor;

begin

s := Edit1.Text;

preparation(s, ['x']);

XScale := PaintBox1.Width / (right - left);

randomize;

col := RGB(random(100), random(100), random(100));

for i := round(left * XScale * k) to round(right * XScale * k) do

if recogn(ChangeVar(s, 'x', i / XScale / k), Num) then

PaintBox1.Canvas.Pixels[round(i / k - left * XScale),

round(PaintBox1.Height / 2 - Num * YScale)] := col;

end;