вот.. писал в далёком детстве, ещё в школу
ех...
стиль кода слегка инфантилен, не пинать
и ещё, код выдран из более масштабного проекта. вроде работает... вроде
да, и ещё - при вводе можно использовать переменную - Х, её значение надо задавать
короче, вот пример использования
Цитата: Enter expression and value of variable (x):
sin(x)+2^3+(2+3*(4+5))/2-tg(x)
2
25.59
press enter
вот сам код[more][no]program calc;
{$APPTYPE CONSOLE}
uses
SysUtils,math;
type tpolizelement=string[30];
var source:string;
poliz:array of tpolizelement;
x:real;
function createpoliz:boolean;
var stack:array of char;
current:word;
s:tpolizelement;
j:integer;
function getsymbol:string;
var s1:string;
begin
while(current<=length(source))and(source[current]=' ')do inc(current);
if current>length(source)then
begin
getsymbol:='';
exit;
end;
if(source[current] in['(',')','^','*','+','-','/'])then
begin
getsymbol:=source[current];
inc(current);
exit;
end;
s1:='';
while(current<=length(source))and(not (source[current] in[' ','(',')','^','*','+','-','/']))do
begin
s1:=s1+source[current];
inc(current);
end;
getsymbol:=s1;
end;
function getshort(s:string):tpolizelement;
var i:real;
j:integer;
begin
if s='' then
begin
getshort:='';
exit;
end;
val(s,i,j);
if j=0 then
begin
getshort:=s;
exit;
end;
if(s[1] in['(',')','^','*','+','-','/'])then
begin
getshort:=s;
exit;
end;
if s='LG' then
getshort:='g'
else
if s='LN' then
getshort:='n'
else
if s='E' then
getshort:='2.718281828459045235'
else
if s='PI' then
getshort:='3.141592653589793238'
else
if s='SIN' then
getshort:='s'
else
if s='COS' then
getshort:='c'
else
if s='TG' then
getshort:='t'
else
if s='SQRT' then
getshort:='q'
else
if s='ARCTG' then
getshort:='a'
else
if s='DIV' then
getshort:='d'
else
if s='MOD' then
getshort:='m'
else
if s='ABS' then
getshort:='b'
else
if s='FRAC' then
getshort:='f'
else
if s='TRUNC' then
getshort:='r'
else
if s='X' then
getshort:='x'
else
if s='ARCSIN'then
getshort:='i'
else
if s='ARCCOS'then
getshort:='o'
else
begin
writeln('Неизвестное выражение: '+s);
getshort:='ERR';
end;
end;
function testnumber(s:tpolizelement):boolean;
var i:real;
c:integer;
begin
val(s,i,c);
result:=c=0;
end;
procedure add(s:tpolizelement);
begin
setlength(poliz,length(poliz)+1);
poliz[length(poliz)-1]:=s;
if s='-'then
begin
setlength(poliz,length(poliz)+1);
poliz[length(poliz)-1]:='+';
end;
end;
function getprior(s:string):integer;
begin
result:=0;
if s='^' then result:=1;
if s='/'then result:=2;
if s='*'then result:=3;
if s='-' then result:=4;
if(s='+')or(s='d')or(s='m')then result:=5;
end;
procedure gotoprior(prior:integer);
begin
if length(stack)=0 then exit;
while(length(stack)>0)and(getprior(stack[length(stack)-1])<=prior)and(stack[length(stack)-1]<>'(')do
begin
add(stack[length(stack)-1]);
setlength(stack,length(stack)-1);
end;
end;
function checkbrackets:boolean;
var b:integer;
i:integer;
begin
b:=0;
i:=1;
while(i<=length(source))and(b>=0)do
begin
if source[i]='('then inc(b);
if source[i]=')'then dec(b);
inc(i);
end;
result:=b=0;
end;
begin
result:=false;
setlength(poliz,0);
if source=''then
begin
writeln('Ошибка в выражении');
exit;
end;
if not checkbrackets then
begin
writeln('Несоответствие числа скобок. Проверьте скобки');
exit;
end;
setlength(stack,0);
current:=1;
s:=getshort(uppercase(getsymbol));
while s<>'' do
begin
if s='ERR'then exit;
if testnumber(s)then add(s)
else
begin
if s='('then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:='(';
end;
if s=')'then
begin
while(length(stack)>0)and(stack[length(stack)-1]<>'(')do
begin
add(stack[length(stack)-1]);
setlength(stack,length(stack)-1);
end;
if length(stack)=0 then
begin
writeln('"(" отсутствует');
exit;
end;
setlength(stack,length(stack)-1);
end;
if s='x'then add('x');
if not((s='(')or(s=')')or(s='x'))then
begin
if(s='-')and(current-2>0)and(source[current-2]='(')then add('0');
gotoprior(getprior(s));
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=s[1];
end;
end;
s:=getshort(uppercase(getsymbol));
end;
if s='ERR'then exit;
for j:=length(stack)-1 downto 0 do add(stack[j]);
result:=true;
end;
function calculatepoliz(x:extended;var success:boolean):extended;
var temp:array of tpolizelement;
i:word;
sx:tpolizelement;
procedure movearray(index,numer:word);
var j,i:word;
begin
i:=index+1;
for j:=i+numer to length(temp)-1do
begin
temp[i]:=temp[j];
inc(i);
end;
setlength(temp,length(temp)-numer);
end;
function ownstrtofloat(str:string):extended;
var i:extended;
j:integer;
begin
val(str,i,j);
result:=i;
end;
function ownfloattostr(float:extended):string;
var k:string;
begin
str(float,k);
result:=k;
end;
function correctfrac(k:extended):extended;
begin
result:=frac(k);
if result<0 then result:=result+1;
end;
begin
setlength(temp,length(poliz));
sx:=ownfloattostr(x);
for i:=0 to length(poliz)-1 do
if poliz[i]<>'x'then
temp[i]:=poliz[i]
else
temp[i]:=sx;
i:=0;
success:=true;
try
while length(temp)<>1 do
case temp[i][1]of
'g':begin
temp[i-1]:=ownfloattostr(log10(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'n':begin
temp[i-1]:=ownfloattostr(ln(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
's':begin
temp[i-1]:=ownfloattostr(sin(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'c':begin
temp[i-1]:=ownfloattostr(cos(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
't':begin
temp[i-1]:=ownfloattostr(tan(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'q':begin
temp[i-1]:=ownfloattostr(sqrt(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'a':begin
temp[i-1]:=ownfloattostr(arctan(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'd':begin
temp[i-2]:=ownfloattostr(round(ownstrtofloat(temp[i-2]))div round(ownstrtofloat(temp[i-1])));
movearray(i-2,2);
i:=0;
end;
'm':begin
temp[i-2]:=ownfloattostr(round(ownstrtofloat(temp[i-2]))mod round(ownstrtofloat(temp[i-1])));
movearray(i-2,2);
i:=0;
end;
'b':begin
temp[i-1]:=ownfloattostr(abs(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'f':begin
temp[i-1]:=ownfloattostr(correctfrac(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'r':begin
temp[i-1]:=ownfloattostr(floor(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'*':begin
temp[i-2]:=ownfloattostr(ownstrtofloat(temp[i-2])*ownstrtofloat(temp[i-1]));
movearray(i-2,2);
i:=0;
end;
'/':begin
temp[i-2]:=ownfloattostr(ownstrtofloat(temp[i-2])/ownstrtofloat(temp[i-1]));
movearray(i-2,2);
i:=0;
end;
'+':if i>1 then
begin
temp[i-2]:=ownfloattostr(ownstrtofloat(temp[i-2])+ownstrtofloat(temp[i-1]));
movearray(i-2,2);
i:=0;
end
else movearray(0,1);
'-':if length(temp[i])=1then
begin
temp[i-1]:=ownfloattostr(-(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end
else inc(i);
'^':begin
temp[i-2]:=ownfloattostr(power(ownstrtofloat(temp[i-2]),ownstrtofloat(temp[i-1])));
movearray(i-2,2);
i:=0;
end;
'i':begin
temp[i-1]:=ownfloattostr(arcsin(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
'o':begin
temp[i-1]:=ownfloattostr(arccos(ownstrtofloat(temp[i-1])));
movearray(i-1,1);
i:=0;
end;
else inc(i);
end;
except
on einvalidop do success:=false;
on ezerodivide do success:=false;
on eoverflow do success:=false;
else writeln('CALCULATEPOLIZerror');
end;
if not success then exit;
result:=ownstrtofloat(temp[0]);
success:=(result<1e100)and(result>-1e100);
end;
var ok:boolean;
begin
{ TODO -oUser -cConsole Main : Insert code here }
writeln('Enter expression and value of variable (x):');
readln(source);
readln(x);
createpoliz();
x:=calculatepoliz(x,ok);
if(not ok)then writeln('err')else writeln(x:0:2);
writeln('press enter');
readln;
end.[/no][/more]основан на полизе, так что советую изучить что это такое - тут ссылки уже давались
