Cod sursa(job #720292)

Utilizator ZancrowAugustin Zancrow Data 22 martie 2012 15:42:32
Problema Evaluarea unei expresii Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
var h,f:text;
    s:array[1..100000] of char;
    ch:char;
    n,j,r:longint;
 {procedure afis;
 var i:integer;
 begin
 for i:=1 to n do write(s[i]);
 writeln;
 end;}
function s2i(s:string):longint;
var r:real; c:integer;
begin
  val(s,r,c);
  s2i:=trunc(r);
end;

function eval(left, right:longint):longint;
var p1,p2,p3,p4,i,pp:longint;
    s2:string;
begin
  p1:=0;p2:=0;p3:=0;p4:=0; pp:=0;
  for i:=left to right do
  if s[i]='(' then inc(pp)
  else if s[i]=')' then dec(pp)
  else if pp=0 then
     case s[i] of
     '+':p1:=i;
     '-':p2:=i;
     '*':p3:=i;
     '/':p4:=i;
     end;

  if p1>p2 then eval:=eval(left,p1-1) + eval(p1+1,right)
  else if p2>0 then eval:=eval(left,p2-1) - eval(p2+1,right)
  else if p3>p4 then eval:=eval(left,p3-1) * eval(p3+1,right)
  else if p4>0 then eval:=eval(left,p4-1) div eval(p4+1,right)
  else if s[left]='(' then eval:=eval(left+1, right-1)
  else begin
  s2:='';
  for i:=left to right do s2:=s2+s[i];
  eval:=s2i(s2);
  end;
end;

begin
  assign(f,'evaluare.in');
   reset(f);
   j:=1;
   while not eoln(f) do begin
   read(f,s[j]);
   inc(j);
   end;
   n:=j-1;
   assign(h,'evaluare.out');
   rewrite(h);
  r:=eval(1,n);
  writeln(h,r);
  close(f);
  close(h);
end.