Код Delphi:
program calc;
{$apptype console}
type
real=double;
const
prs='+-*/(';
pri:array [1..5] of byte = (1,1,2,2,0);
var
s1,s2:string;
q:array[0..500] of real;
w:array[0..500] of char;
n,len,len2,i,j:longint;
t:real;
ch:char;
procedure push(x:real);
begin
inc(len);
q[len]:=x;
end;
function pop:real;
begin
pop:=q[len];
q[len]:=0;
dec(len);
end;
procedure pushc(x:char);
begin
inc(len2);
w[len2]:=x;
end;
function popc:char;
begin
popc:=w[len2];
w[len2]:=#0;
dec(len2);
end;
function oper(s1,s2:real;s3:char):real;
var
s:string;
x,y,z:real;
tmp:integer;
begin
x:=s1;
y:=s2;
case s3 of
'+':z:=x+y;
'-':z:=x-y;
'*':z:=x*y;
'/':z:=x/y;
end;
oper:=z;
end;
procedure prechange(var s:string);
var
i:longint;
begin
if s[1]='-' then s:='0'+s;
i:=1;
while i<=n do if (s[i]='(')and(s[i+1]='-') then insert('0',s,i+1) else inc(i);
end;
function change(s:string):string;
var
i:longint;
rezs:string;
c:boolean;
begin
c:=false;
for i:=1 to n do begin
if not(s[i] in ['+','-','*','/','(',')']) then begin
if c then rezs:=rezs+' ';
rezs:=rezs+s[i];
c:=false;
end
else begin
c:=true;
if s[i]='(' then pushc(s[i]) else
if s[i]=')' then begin
while w[len2]<>'(' do begin
rezs:=rezs+' '+popc;
end;
popc;
end else
if s[i] in ['+','-','*','/'] then begin
while pri[pos(w[len2],prs)]>=pri[pos(s[i],prs)] do rezs:=rezs+' '+popc;
pushc(s[i]);
end;
end;
end;
while len2<>0 do rezs:=rezs+' '+popc;
change:=rezs;
end;
function count(s:string):real;
var
ss:string;
x,s1,s2:real;
chh,s3:char;
p,i,j:longint;
tmp:integer;
begin
i:=0;
repeat
j:=i+1;
repeat inc(i) until s[i]=' ';
ss:=copy(s,j,i-j);
chh:=ss[1];
if not(chh in ['+','-','*','/']) then begin
val(ss,p,tmp);
push(p);
end
else begin
s2:=pop;
s1:=pop;
s3:=chh;
push(oper(s1,s2,s3));
end;
until i>=n;
x:=pop;
count:=x;
end;
procedure writeL(x:real);
var
y,a,b:longint;
q:real;
begin
y:=trunc(x);
b:=0;
if abs(x-y)<(1e-12) then
writeln(y)
else begin
if y>0 then a:=round(ln(y)/ln(10))+1 else a:=1;
q:=x;
repeat
q:=q*10;
inc(b);
until abs(q-trunc(q))<(1e-12);
writeln(x:a+b:b);
end;
end;
begin
repeat
writeln('Enter expression');
readln(s1);
n:=length(s1);
prechange(s1);
n:=length(s1);
s2:=change(s1);
if s2[1]=' ' then delete(s2,1,1);
s2:=s2+' ';
n:=length(s2);
t:=count(s2);
writeL(t);
writeln('One more expression?(Y/N)');
readln(ch);
until upcase(ch)='N';
end.Colored with dumpz.org
Colored with dumpz.org
Код Haskell:
calc :: String -> [Float]
calc = foldl f [] . words
where
f (x:y:zs) "+" = (y + x):zs
f (x:y:zs) "-" = (y - x):zs
f (x:y:zs) "*" = (y * x):zs
f (x:y:zs) "/" = (y / x):zs
f xs y = read y : xsColored with dumpz.org
Colored with dumpz.org
Сообщения
