Cod sursa(job #297852)

Utilizator punkistBarbulescu Dan punkist Data 5 aprilie 2009 17:43:10
Problema Evaluarea unei expresii Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 4.45 kb
type stiva=^element;
     element=record
              nr:char;
              leg:stiva;
             end;

     stivanr=^element2;
     element2=record
               nr:int64;
               leg:stivanr;
              end;

var s,s2:array[1..100050] of char;
    sol,k,m:int64;
    test:stiva;

procedure Citeste;
var f:text;
 begin
  assign(f,'evaluare.in');
  reset(f);
  m:=0;
  while not eoln(f) do
   begin
    m:=m+1;
    read(f,s[m]);
   end;
  close(f);
 end;

function isempty(var st:stiva):boolean;
 begin
  if st^.nr='-' then isempty:=true
  else isempty:=false;
 end;

function isempty(var st:stivanr):boolean;
 begin
  if st^.nr=-1 then isempty:=true
  else isempty:=false;
 end;


procedure emptystack(var st:stiva);
 var p:stiva;
 begin
  Dispose(st);
  New(p);
  st:=p;
  st^.nr:='-';
  st^.leg:=nil;
 end;

procedure emptystack(var st:stivanr);
 var p:stivanr;
 begin
  Dispose(st);
  New(p);
  st:=p;
  st^.nr:=-1;
  st^.leg:=nil;
 end;


procedure push(var st:stiva;item:char);
 var p:stiva;
 begin
  New(p);
  p^.nr:=item;
  p^.leg:=st;
  st:=p;
 end;

procedure push(var st:stivanr;item:int64);
 var p:stivanr;
 begin
  New(p);
  p^.nr:=item;
  p^.leg:=st;
  st:=p;
 end;

function pop(var st:stiva):char;
 var ret:char;
     p:stiva;
 begin
  ret:=st^.nr;
  if ret<>'-' then
  begin
   p:=st;
   st:=st^.leg;
   Dispose(p);
  end;
  pop:=ret;
 end;

function pop(var st:stivanr):int64;
 var ret:int64;
     p:stivanr;
 begin
  ret:=st^.nr;
  if ret<>-1 then
  begin
   p:=st;
   st:=st^.leg;
   Dispose(p);
  end;
  pop:=ret;
 end;


function isoperator(e:char):boolean;
 begin
  if (e='+') or (e='-') or (e='*') or (e='/') then isoperator:=true
  else isoperator:=false;
 end;

function prioritate(e:char):integer;
 var pri:integer;
 begin
  pri:=0;
  if (e='*') or (e='/') then pri:=2
  else
   begin
    if (e='+') or (e='-') then pri:=1;
   end;
  prioritate:=pri;
 end;

procedure infix2postfix;
 var i,p:int64;
     n1:char;
     x:stiva;
 begin
  emptystack(x);
  i:=1;
  p:=1;
  while (i<=m) do
   begin
    while (s[i]=' ') do i:=i+1;

    if (s[i]>='0') and (s[i]<='9') then
     begin
      while (s[i]>='0') and (s[i]<='9')  do
       begin
        s2[p]:=s[i];
        p:=p+1;
        i:=i+1;
       end;
       s2[p]:=' ';
       p:=p+1;
     end;

     if (s[i]='(') then
      begin
       push(x,s[i]);
       i:=i+1;
      end;

     if (s[i]=')') then
      begin
       n1:=pop(x);
       while (n1 <> '(') do
        begin
         s2[p]:=n1;
         p:=p+1;
         s2[p]:=' ';
         p:=p+1;
         n1:=pop(x);
        end;
       i:=i+1;
      end;

     if isoperator(s[i]) then
      begin
       if isempty(x) then push(x,s[i])
       else
        begin
         n1:=pop(x);
         while (prioritate(n1) >= prioritate(s[i])) and (n1<>'-') do
          begin
           s2[p]:=n1;
           p:=p+1;
           s2[p]:=' ';
           p:=p+1;
           n1:=pop(x);
          end;
          push(x,n1);
          push(x,s[i]);
        end;
       i:=i+1;
      end;
   end;
  while not isempty(x) do
   begin
    n1:=pop(x);
    s2[p]:=n1;
    p:=p+1;
    s2[p]:=' ';
    p:=p+1;
   end;
  while p<100000 do
   begin
    s2[p]:='-';
    p:=p+1;
   end;
 end;

procedure evaluate;
 var p:int64;
     stk:stivanr;
     op1,op2,rez:int64;
 begin
  emptystack(stk);
  p:=1;
  while (s2[p]<>'-') do
   begin
    while (s2[p]=' ') do p:=p+1;
    if s2[p]<>'-' then
    begin
     if (s2[p]>='0') and (s2[p]<='9') then
     begin
      {e un numar}
      rez:=0;
      while (s2[p]>='0') and (s2[p]<='9') do
       begin
        rez:=rez * 10 + ord(s2[p]) - ord('0');
        p:=p+1;
       end;
      if not ((s2[p]>='0') and (s2[p]<='9')) then p:=p-1;
      push(stk,rez);
     end
     else
      begin
       {e un operator}
       op1 := pop(stk);
       op2 := pop(stk);
       if s2[p]='+' then rez:=op2+op1;
       if s2[p]='-' then rez:=op2-op1;
       if s2[p]='/' then rez:=op2 div op1;
       if s2[p]='*' then rez:=op2 * op1;
      { writeln(op2,s2[p],op1,'=',rez); }
       push(stk,rez);
      end;
     p:=p+1;
    end;
  end;
  rez:=pop(stk);
  sol:=rez;
 end;

procedure Scrie;
 var f:text;
 begin
  assign(f,'evaluare.out');
  rewrite(f);
  writeln(f,sol);
  close(f);
 end;
begin
Citeste;
infix2postfix;
evaluate;
Scrie;
end.