const NIC =0; SOUCET =1; ODECET =3; NASOBENI=4; DELENI =5; ZAPORNE_NASOBENI =6; ZAPORNE_DELENI =7; CHYBA_ZADNA = 0; CHYBA_ZADANI = 1; CHYBA_DELENI_0 = 2; CHYBA_ZAPORNA_ODMOCNINA = 3; symboly = ['+','-','*','/']; cislice = ['0'..'9','.']; pocet_funkci = 11; funkce:array[1..pocet_funkci] of string[10] = ('SIN', 'COS', 'SQR', 'SQRT', 'TAN', 'COTAN', 'ARCSIN', 'ARCCOS', 'ARCTAN', 'LN', 'EXP' ); var pozice_chyby:byte; druh_chyby:byte; Function Uroven1(s:string):real;forward; Function Operace2(r,r2:real;o:byte):real; begin case o of NIC : r:=r2; NASOBENI : r:=r*r2; DELENI : if r2=0 then begin druh_chyby:=CHYBA_DELENI_0; Operace2:=0; Exit; end else r:=r/r2; ZAPORNE_NASOBENI: r:=-r*r2; ZAPORNE_DELENI : r:=-r/r2; end; {case} Operace2:=r; end; Function Operace1(r,r2:real;o:byte):real; begin case o of NIC: r:=r2; SOUCET:r:=r+r2; ODECET:r:=r-r2; end; {case} Operace1:=r; end; Function ZpracujClen(t:string;r,r2:real;o:byte):real; var k:integer; i:byte; n:real; s:string[10]; begin Val(t,r2,k); {napred to zkus proste prevest na cislo} if k<>0 then {konverze cisla se nepovedla, tudiz je to neco slozitejsiho} if t[1]='(' then begin {zacina to zavorkou, je to tedy zavorka} delete(t,Length(t),1); delete(t,1,1); r2:=Uroven1(t); end else begin k:=Pos('(',t); {zavorka je uvnitr kazdopadne, ale co je pred ni?} s:=Copy(t,1,k-1); delete(t,Length(t),1); delete(t,1,k); r2:=Uroven1(t); if s='SIN' then r2:=sin(r2) else if s='COS' then r2:=cos(r2) else if s='SQR' then r2:=sqr(r2) else if s='SQRT' then begin if r2<0 then begin ZpracujClen:=0;druh_chyby:=CHYBA_ZAPORNA_ODMOCNINA;Exit;end; r2:=sqrt(r2); end else if s='TAN' then begin n:=cos(r2); if n=0 then begin ZpracujClen:=0;druh_chyby:=CHYBA_DELENI_0;Exit;end; r2:=sin(r2)/n; end else if s='COTAN' then begin n:=sin(r2); if n=0 then begin ZpracujClen:=0;druh_chyby:=CHYBA_DELENI_0;Exit;end; r2:=cos(r2)/n; end else if s='ARCSIN' then begin if (r2>=1) or (r2<=-1) then begin ZpracujClen:=0;druh_chyby:=CHYBA_DELENI_0;Exit;end; r2:=ArcTan(r2/sqrt(1-sqr(r2))); end else if s='ARCCOS' then begin if (r2>=1) or (r2<=-1) or (r2=0) then begin ZpracujClen:=0;druh_chyby:=CHYBA_DELENI_0;Exit;end; r2:=ArcTan(sqrt(1-sqr(r2)/r2)); end else if s='ARCTAN' then r2:=ArcTan(r2) else if s='LN' then r2:=Ln(r2) else if s='EXP' then r2:=Exp(r2); end; ZpracujClen:=Operace2(r,r2,o); end; Function Uroven2(const s:string):real; var i,o,z:byte; r,r2:real; k:integer; t:string; begin if s='' then begin Uroven2:=0;Exit;end; t:=''; o:=NIC; r:=0; z:=0; for i:=1 to Length(s) do begin if s[i]='(' then inc(z); if s[i]=')' then dec(z); if (z<>0) or (not (s[i] in ['*','/','@','#'])) then t:=t+s[i] else begin r:=ZpracujClen(t,r,r2,o); if druh_chyby<>CHYBA_ZADNA then begin Uroven2:=0; Exit; end; t:=''; case s[i] of '*':o:=NASOBENI; '/':o:=DELENI; '@':o:=ZAPORNE_NASOBENI; '#':o:=ZAPORNE_DELENI; end; {case} end; {else begin} end; {dodelame posledni cislo, za kterym uz neni znak zadne operace} Uroven2:=ZpracujClen(t,r,r2,o); end; Function BackPos(c:char;s:string):byte; var i:byte; begin for i:=Length(s) downto 1 do if s[i]=c then begin BackPos:=i;Exit;end; BackPos:=0; end; Function Uroven1(s:string):real; var z,i,o:byte; r,r2:real; t:string; begin if s='' then begin Uroven1:=0;Exit;end; t:=''; o:=NIC; r:=0; z:=0; for i:=1 to Length(s) do begin if s[i]='(' then inc(z); if s[i]=')' then dec(z); if (z<>0) or (not (s[i] in ['+','-'])) then t:=t+s[i] else begin r2:=Uroven2(t); r:=Operace1(r,r2,o); t:=''; case s[i] of '+':o:=SOUCET; '-':o:=ODECET; end; {case} end; {else begin} end; {dodelame posledni cislo, za kterym uz neni znak zadne operace} if druh_chyby<>CHYBA_ZADNA then begin Uroven1:=0; Exit; end; r2:=Uroven2(t); Uroven1:=Operace1(r,r2,o); end; Function ZrusMezeryADejNaVelka(s:string):string; var t:string; i:byte; begin t:=''; for i:=1 to Length(s) do if s[i]<>' ' then t:=t+UpCase(s[i]); ZrusMezeryADejNaVelka:=t; end; Function SpravneUzavorkovani(s:string):byte; var i:shortint; j,k:byte; begin j:=0; for i:=1 to Length(s) do if s[i]='(' then begin inc(j);k:=i;end else if s[i]=')' then if i=0 then begin SpravneUzavorkovani:=i; Exit; end else dec(j); if j<>0 then SpravneUzavorkovani:=k else SpravneUzavorkovani:=0; end; Function ZkontrolujCislo(s:string):boolean; var k:integer; r:real; bpz:boolean; h,i,j,prc,poc:byte; t,u:string; begin Val(s,r,k); if k=0 then begin ZkontrolujCislo:=true;Exit;end; {je to zkratka platne cislo...} bpz:=false; prc:=0; poc:=0; for j:=1 to Length(s) do if not (s[j] in cislice) then begin if s[j]=')' then bpz:=true {byla zaznamenana prava zavorka} else if prc>0 then begin ZkontrolujCislo:=false;Exit;end; end else if bpz=true {cislice za pravou zavorkou? Nelze} then begin ZkontrolujCislo:=false;Exit;end else begin if prc=0 then prc:=j; {prvni cislice} poc:=j; {posledni cislice} end; Val(Copy(s,prc,poc-prc+1),r,k); {zkontroluj usek mezi zavorkami} if k<>0 then {v neporadku? patrne vice desetinnych tecek} begin ZkontrolujCislo:=false;Exit;end; t:=Copy(s,1,prc-1); {rozbor retezce pred levou zavorkou} while t<>'' do begin {sqrt(sqr(} i:=Pos('(',t); if i=0 then begin ZkontrolujCislo:=false;Exit;end; if i>1 then begin u:=Copy(t,1,i-1); {Vime, ze pred zavorkou je pritomna jakasi matematicka funkce.} {Znam ji ale?} bpz:=false; for j:=1 to pocet_funkci do if u=funkce[j] then begin bpz:=true;Break;end; {znama funkce} if bpz=false then begin ZkontrolujCislo:=false;Exit;end; delete(t,1,i); end else delete(t,1,1); end; {-----------------------------------------------------------------} for i:=prc+1 to Length(s) do {kontrola pravych zavorek} if s[i]<>')' then begin ZkontrolujCislo:=false;Exit;end; ZkontrolujCislo:=true; {sem se procedura dostane v pripade, ze jsou pritomny} {prave zavorky a jsou v poradku} end; Procedure Preprocesor(s:string;var t:string;var chyba:byte); var i,j:byte; k:integer; c,d:char; r:real; uvnitr:boolean; u:string; begin t:=ZrusMezeryADejNaVelka(s); {zrusim mezery, aby se to lepe prohledavalo} s:=''; chyba:=SpravneUzavorkovani(t); if chyba<>0 then Exit; uvnitr:=true; {zaciname uvnitr cisla} u:=''; for i:=1 to Length(t) do begin if uvnitr=true then {uvitr cisla...} begin if not (t[i] in symboly) then u:=u+t[i] else begin if ZkontrolujCislo(u)=false then begin chyba:=i-Length(u)+1; Exit; end; s:=s+u; u:=t[i]; uvnitr:=false; end; end else begin {jsme vne cisla...} if t[i] in symboly then u:=u+t[i] else begin if Length(u)>1 then {kombinace symbolu?} begin if u='--' then u:='+' else if u='+-' then u:='-' else if u='*-' then u:='@' else {ZAPORNE NASOBENI} if u='/-' then u:='#' else {ZAPORNE DELENI} if u='*--' then u:='*' else if u='/--' then u:='/' else begin {ostatni kombinace nejsou povolene} chyba:=i-1; Exit; end; end; s:=s+u; u:=t[i]; uvnitr:=true; end; end; end; {for} if uvnitr=false then {na konci vyrazu musi byt cislo, ne symbol} begin chyba:=i; Exit; end; if ZkontrolujCislo(u)=false then begin chyba:=i-Length(u)+1; Exit; end; chyba:=0; s:=s+u; t:=s; end; Function Parser(s:string):real; var n:byte; r:real; t:string; begin Preprocesor(s,t,n); if n<>0 then begin druh_chyby:=CHYBA_ZADANI; pozice_chyby:=n; Parser:=0; end else begin pozice_chyby:=0; druh_chyby:=CHYBA_ZADNA; r:=Uroven1(t); Parser:=r; end; end; Function XMezer(i:byte):string; var a:byte; s:string; begin s:=''; for a:=1 to i do s:=s+' '; XMezer:=s; end; Function Pos_s_mezerami(s:string;i:byte):byte; var a,b,c:byte; begin b:=0; a:=0; c:=Length(s); repeat inc(a); if s[a]<>' ' then begin inc(b); if b=i then begin Pos_s_mezerami:=a;Exit;end; end; until a=c; Pos_s_mezerami:=0; end; var s:string; i:byte; r:real; begin writeln('Znam tyto matematicke funkce:'); for i:=1 to pocet_funkci do writeln(funkce[i]); writeln(#13#10,'Zadej matematicky vyraz:'); readln(s); r:=Parser(s); case druh_chyby of CHYBA_ZADANI:begin i:=pos_s_mezerami(s,pozice_chyby); writeln('Chyba v zadanem vyrazu na poz. c.',i); writeln(s); writeln(xmezer(i-1),'^'); end; CHYBA_DELENI_0:writeln('Deleni nulou!'); CHYBA_ZAPORNA_ODMOCNINA:writeln('Zaporny argument druhe odmocniny'); else begin writeln('vysledek je: '); if frac(r)=0 then i:=0 else i:=3; writeln(r:1:i); end; end; readln; end.