{ aritmet.pas Copyright (c) TrSek alias Zdeno Sekerak } { Unit na vyhodnotenie aritmetickeho vyrazu za pomoci rekurzii podla } { stavby vyrazu. } { } { Datum:17.09.2005 http://www.trsek.com } unit aritmet; interface uses crt; var S: string; { vyhodnocovany vyraz } vys: real; { vysledok vyrazu } pError: integer; { pozicia chyby } function Vyhodnot(S:string;x,y:real): real; implementation { Vyhodnocovany vyraz je vo vstupnom parametry S} function Vyhodnot(S:string;x,y:real): real; var poz:integer; { vyhodnocovana pozicia } function Vyraz(var S: string): real; forward; { zmaz prvy znak } procedure DeleteOne(var S:string); begin inc(poz); Delete(S,1,1); end; {zmaze zbytocne mezery} procedure BezMezer(var s:string); begin while(s[1]=' ') do DeleteOne(s); end; { ulozi si chybovy stav } procedure PutError; begin { ak uz neaka chyba je tak nic } if( pError=0 )then pError:=poz; end; { zisti cele cislo, take co sa sklada iba z 0..9 } function CeleCislo(var S:string):integer; var H:integer; begin H := 0; while S[1] in ['0'..'9'] do begin H := H * 10 + ord(S[1]) - ord('0'); DeleteOne(S); BezMezer(S); end; CeleCislo:=H; end; { prevrati na desatinu cast } function Desatine(H:real):real; begin while(Int(H)>0) do H := H/10; Desatine := H; end; { zisti cislo int/real } { prisiel sem lebo string zacial cislom 0..9 } function MakeNumber(var S:string):real; var H: real; {skutocne cislo} begin H := CeleCislo(S); { bude desatina cast, realne cislo } if(S[1] = '.')then begin DeleteOne(S); H := H + Desatine( CeleCislo(S)); end; { cislo s exponentom } if(UpCase(S[1]) = 'E')then begin DeleteOne(S); { kladny exponent } if(S[1]='+')then begin DeleteOne(S); H:=H * Exp(CeleCislo(S)*Ln(10)); end; { zaporny exponent } if(S[1]='-')then begin DeleteOne(S); H:=H / Exp(CeleCislo(S)*Ln(10)); end; { ziadny exponent } if(S[1] in ['0'..'9'])then H:=H * Exp(CeleCislo(S)*Ln(10)); end; MakeNumber := H; end; { vykona funkciu } function MakeFunc(name:string; H:real):real; var K:boolean; { pozna taku funkciu } begin K:=true; if(name='SIN' )then begin MakeFunc := sin(H); K:=false; end; if(name='COS' )then begin MakeFunc := cos(H); K:=false; end; if(name='INT' )then begin MakeFunc := int(H); K:=false; end; if(name='ABS' )then begin MakeFunc := abs(H); K:=false; end; if(name='SQRT' )then begin MakeFunc := sqrt(H); K:=false; end; if(name='LN' )then begin MakeFunc := ln(H); K:=false; end; if(name='LOG' )then begin MakeFunc := ln(H)/ln(10); K:=false; end; if(name='TAN' )then begin MakeFunc := sin(x)/cos(x); K:=false; end; if(name='COTAN' )then begin MakeFunc := cos(x)/sin(x); K:=false; end; if(name='ARCTAN')then begin MakeFunc := arctan(H); K:=false; end; { taku fuknciu nema definovanu } if(K)then PutError; end; { zistuje nazvy funkcii } function FindFunc(var S:string):real; var name: string; H: real; begin FindFunc := 0; name := ''; while S[1] in ['A'..'z'] do begin name := name + UpCase(S[1]); DeleteOne(S); end; BezMezer(S); { skoncil text } { ak bude pokracovat text je to funkcia, inac konstanta } if S[1] = '(' then begin DeleteOne(S); {zrusit levou zavorku} FindFunc := MakeFunc(name, Vyraz(S)); { ocakavam pravu zatvorku } if S[1] <> ')' then PutError else DeleteOne(S); {zrusit pravou zavorku} end else { je to x alebo y } if name<>'' then begin if( name='X' )then FindFunc:=x; if( name='Y' )then FindFunc:=y; end; end; { funkcia na vyhodnotenie faktoru } { faktorom je ciselna hodnota alebo vyraz v zatvorkach } function Faktor(var S: string): real; var M:integer; begin BezMezer(S); { vyraz nesmie zacinat pravou zatvorkou } if S[1] = ')' then PutError; if S[1] = '(' then begin DeleteOne(S); {zrusit levu zatvorku} Faktor := Vyraz(S); { ocakavam pravu zatvorku } if S[1] <> ')' then PutError else DeleteOne(S); {zrusit pravou zavorku} end else {ciselna konstanta} begin BezMezer(S); { je to zaporne cislo? } M:=1; if( S[1]='-' )then begin M:=-1; DeleteOne(S); end; { Faktor nesmie zacinat znamienkom } if( S[1] in ['+','-','*','/'])then PutError; if(S[1] in ['0'..'9'])then { hladaj cislo } Faktor := M*MakeNumber(S) else { hladaj nazov funkcie } Faktor := FindFunc(S); end; end; { funkcia na vyhodnocuje jeden clen } { clenom je faktor alebo soucin/podiel viacerych faktorov } function Clen(var S: string): real; var C: real; { clen } FC: real; { aby som mohol kontrolovat ze nedeli nulov } begin BezMezer(S); C := Faktor(S); BezMezer(S); while S[1] in ['*','/'] do begin if S[1] = '*' then {sucin faktorov} begin DeleteOne(S); C := C * Faktor(S); end; if S[1] = '/' then {podiel faktorov} begin DeleteOne(S); FC := Faktor(S); if(FC<>0)then C := C/FC else PutError; end; end; Clen := C end; { funkcia na vyhodnotenie vyrazu } function Vyraz(var S: string): real; var V: real; {hodnota vyrazu} begin V := Clen(S); BezMezer(S); while S[1] in ['+','-'] do begin if S[1] = '+' then {sucet clenov} begin DeleteOne(S); V := V + Clen(S); end; if S[1] = '-' then {rozdiel clenov} begin DeleteOne(S); V := V - Clen(S); end; end; Vyraz := V end; begin pError := 0; poz := 1; S := S + '$'; {technicky trik pre koniec } Vyhodnot := Vyraz(S); BezMezer(S); { zostala neaka zatvorka, alebo iny znak ? } if( S[1]<>'$' )then PutError; end; begin end.