{ ARITMETICKT_VYRAZ.PAS } { Vyhodnoceni aritmetickeho vyrazu soustavou procedur ve vztahu } { neprime rekurze podle formalni gramatiky stavby vyrazu. } { } { Datum:13.07.2013 http://www.trsek.com } program AritmetVyraz; uses crt; const MAX_CONST = 10; { velkost bufera konstant } ERR_SIGN = 'Vyskytli sa 2 znamienka za sebou'; ERR_UNCMP = 'Chyba clen pre matematicku operaciu'; DIV_ZERO = 'Nastalo delenie nulou'; ERR_BRK_L = 'Nespravny pocet zatvoriek, chyba lava zatvorka'; ERR_BRK_R = 'Nespravny pocet zatvoriek, chyba prava zatvorka'; ERR_UNK = 'Neznama funkcia :'; var S: string; { ulozeni vyhodnocovaneho vyrazu } pError: integer; { pozicia chyby } sError: string; { popis chyby } vys: real; { vysledok vyrazu } nameC:array[1..MAX_CONST] of string; realC:array[1..MAX_CONST] of real; { funkce vyhodnocujici artitmeticky vyraz } { metoda - neprima rekurze funkci Vyraz, Clen, Faktor } { vyhodnocovany vyraz je zadan ve vstupnim parametru S } { funkce predpoklada, ze vyraz je syntakticky spravny } function Vyhodnoceni(S:string): real; var poz:integer; { na akej pozicii vo vyraze } function Vyraz(var S: string): real; forward; { zmaz prvy znak } { zaroven si pamata kolko znakov od zaciatku sa nachadza, premena p } 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(error:string); begin { ak uz neaka chyba je tak nic } if( pError=0 )then begin pError:=poz; sError:=error; end; 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( ERR_UNK + name ); end; { vypita si hodnotu konstaty } { ak uz taka je v zozname vrati jej hodnotu } function GetConst(name:string):real; var i: integer; begin i:=1; { najdeme taky s nazvom name } while((nameC[i]<>name) and (nameC[i]<>'') and (i ')' then PutError( ERR_BRK_R ) else DeleteOne(S); {zrusit pravou zavorku} end else if name<>'' then FindFunc:=GetConst(name); end; {pomocna funkce na vyhodnoceni jednoho faktoru} {faktorem je ciselna hodnota nebo vyraz v zavorkach} function Faktor(var S: string): real; var M:integer; begin BezMezer(S); { vyraz nesmie zacinat pravou zatvorkou } if S[1] = ')' then PutError( ERR_BRK_L ); if S[1] = '(' then begin DeleteOne(S); {zrusit levou zavorku} Faktor := Vyraz(S); { ocakavam pravu zatvorku } if S[1] <> ')' then PutError( ERR_BRK_R ) 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 begin if( poz=1 )then PutError( ERR_UNCMP ) else PutError( ERR_SIGN ); end; if(S[1] in ['0'..'9'])then { hladaj cislo } Faktor := M*MakeNumber(S) else begin { hladaj konstantu, alebo nazov funkcie } if S[1] = '(' then Faktor := M*Faktor(S) { mala rekururzia } else Faktor := M*FindFunc(S); end; end; end; {pomocna funkce na vyhodnoceni jednoho clenu} {clenem je jeden faktor nebo soucin/podil vice faktoru} function Clen(var S: string): real; var C: real; {hodnota clenu} 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 {soucin faktoru} begin DeleteOne(S); C := C * Faktor(S); end; if S[1] = '/' then {podil faktoru} begin DeleteOne(S); FC := Faktor(S); if(FC<>0)then C := C/FC else PutError(DIV_ZERO); end; end; Clen := C end; { funkce na vyhodnoceni vyrazu } { vyraz je clen nebo soucet/rozdil clenu } 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 {soucet clenu} begin DeleteOne(S); V := V + Clen(S); end; if S[1] = '-' then {rozdil clenu} begin DeleteOne(S); V := V - Clen(S); end; end; Vyraz := V end; begin {function Vyhodnoceni} pError := 0; poz := 1; S := S + '$'; {technicky trik pro ukonceni} Vyhodnoceni := Vyraz(S); { zostala neaka zatvorka, alebo iny znak ? } BezMezer(S); if S[1]=')' then PutError( ERR_BRK_L ); if S[1]='(' then PutError( ERR_BRK_R ); if S[1]<>'$' then PutError( ERR_UNK ); end; {function Vyhodnoceni} begin repeat writeln; textcolor(blue); writeln('Program vyhodnocuje aritmeticky vyraz.'); writeln; textcolor(white); writeln('Uzivatel moze pracovat s realnymi cislami-zadavaju sa v tvare 25.3E+4.'); writeln('Ak uzivatel zada realne cislo v tvare 25.3E4,'); writeln('program ho vyhodnocuje ako cislo s kladnym exponentom.'); writeln; writeln('Uzivatel moze pouzivat premenne (pismena anglickej abecedy).'); writeln('Moze ich byt maximalne 10.':58); writeln; writeln('Uzivatel moze pouzivat funkcie: sin, cos, int, abs a sqrt.'); writeln; writeln('Uzivatel moze urobit v zadani nasledovne chyby:'); writeln(' - 2 znamienka za sebou alebo bude chybat clen'); writeln(' - delenie nulou'); writeln(' - nespravny pocet zatvoriek-chyba prava alebo lava zatvorka'); writeln(' - neznama funkcia'); writeln; writeln('Program uzivatelovi oznami druh a poziciu chyby aby to uzivatel mohol opravit.'); writeln; writeln; textcolor(blue); write('Napis vyhodnocovany vyraz:'); textcolor(yellow); readln(S); vys:=Vyhodnoceni(S); if(pError<>0)then writeln('Cyba na pozicii ',pError,'->',sError) else writeln('Hodnota vyrazu: ', vys:0:5 ); until( pError=0 ); readln end.