Contributor: WARREN PORTER
{
From: WARREN PORTER
Subj: eval
Program to evaluate expressions using a stack. }
const
Maxstack = 100;
type
stack = record
top : 0..Maxstack;
Item : array[1..Maxstack] of char
end;
RealStack = record
top: 0..Maxstack;
Item : array[1..Maxstack] of real
end;
xptype = record
oper : char;
opnd : real
end;
Function Empty(var A:stack):boolean;
Begin
Empty:= A.top = 0;
End;
Function Pop(var A:stack):char;
Begin
if A.Top < 1 then begin writeln('Attempt to pop an empty stack'); halt(1) end; Pop:= A.item[A.top]; A.top:= A.top - 1 End; Procedure Push(var A:stack; Nchar:char); Begin if A.Top = Maxstack then begin writeln('Stack already full'); halt(1) end; A.top:= A.top + 1; A.item[A.top]:=Nchar End; {The following functions are for the real stack only.} Function REmpty(var D:RealStack):boolean; Begin REmpty:= D.top = 0; End; Function RPop(var D:RealStack):real; Begin if D.Top < 1 then begin writeln('Attempt to pop an empty RealStack'); halt(1) end; RPop:= D.item[D.top]; D.top:= D.top - 1 End; Procedure RPush(var D:RealStack; Nreal:real); Begin if D.Top = MaxStack then begin writeln('Stack already full'); halt(1) end; D.top:= D.top + 1; D.item[D.top]:=Nreal End; Function pri(op1, op2:char):boolean; var tpri: boolean; Begin if op2 = ')' then tpri:= true else if (op1 = '$') and (op2 '$') and (op2 '(') then
tpri:= true else
if (op1 in ['*','/']) and (op2 in ['+','-']) then
tpri:= true
else
tpri:= false;
pri:= tpri{;
write('Eval op 1= ',op1, ' op2 = ',op2);
if tpri= false then
writeln(' false')
else
writeln(' true')}
End;
Function ConvReal(a:real;NumDec:integer):real;
var
i, tenpower: integer;
Begin
tenpower:= 1;
for i:= 1 to NumDec do
tenpower:= tenpower * 10;
ConvReal:= a / tenpower
End;
Function ROper(opnd1, opnd2: real; oper: char):real;
Var temp: real;
Begin
Case oper of
'+': temp:= opnd1 + opnd2;
'-': temp:= opnd1 - opnd2;
'*': temp:= opnd1 * opnd2;
'/': temp:= opnd1 / opnd2;
'$': temp:= exp(ln(opnd1) * opnd2)
End {Case} ;
{Writeln(opnd1:6:3,' ',oper,' ',opnd2:6:3 ,' = ',temp:6:3);}
ROper := temp
End; {R oper}
{Main procedure starts here}
var
A: stack;
Inbuff:string[Maxstack];
len, i, j, NumDecPnt, lenexp: integer;
temp, opnd1, opnd2, result : real;
valid, expdigit, expdec, isneg, openok: boolean;
operators, digits : set of char;
HoldTop : char;
B: array[1..Maxstack] of xptype;
C: array[1..Maxstack] of xptype;
D: RealStack;
Begin
digits:= ['0'..'9'];
operators:= ['$','*','/','+','-','(',')'];
Writeln('Enter expression to evaluate or RETURN to stop');
Writeln('A space should follow a minus sign unless it is used to');
Writeln('negate the following number. Real numbers with multi-');
Writeln('digits and decimal point (if needed) may be entered.');
Writeln;
Readln(Inbuff);
len:=length(Inbuff);
repeat
i:= 1;
A.top:= 0;
valid:= true;
repeat
if Inbuff[i] in ['(','[','{'] then
push(A,Inbuff[i])
else
if Inbuff[i] in [')',']','}'] then
if empty(A) then
valid:= false
else
if (ord(Inbuff[i]) - ord(Pop(A)))> 2 then
valid:= false;
i:= i + 1
until (i> len) or (not valid);
if not empty(A) then
valid:= false;
if not valid then
Writeln('The expression is invalid')
else
Begin
{Change all groupings to parenthesis}
for i:= 1 to len do Begin
if Inbuff[i] in ['[','{'] then
Inbuff[i]:= '(' else
if Inbuff[i] in [']','}'] then
Inbuff[i]:= ')';
B[i].oper:= ' ';
B[i].opnd:= 0;
C[i].oper:= ' ';
C[i].opnd:= 0 End;
{ The B array will be the reformatted input string.
The C array will be the postfix expression. }
i:= 1; j:= 1; expdigit:= false; expdec:= false; isneg:= false;
while i <= len do Begin if (Inbuff[i] = '-') and (Inbuff[i + 1] in digits) then Begin isneg:= true; i:= i + 1 End; if (Inbuff[i] = '.' ) then Begin i:= i + 1; expdec:= true End; if Inbuff[i] in digits then Begin if expdec then NumDecPnt:= NumDecPnt + 1; if expdigit then temp:= temp * 10 + ord(inbuff[i]) - ord('0') else Begin temp:= ord(inbuff[i]) - ord('0'); expdigit:= true End End else if expdigit = true then Begin if isneg then temp:= temp * -1; B[j].opnd:= ConvReal(temp,NumDecPnt); j:= j + 1; expdigit := false; expdec := false; NumDecPnt:= 0; isneg:= false End; If Inbuff[i] in operators then Begin B[j].oper:= Inbuff[i]; j:= j + 1 End; if not (Inbuff[i] in digits) and not (Inbuff[i] in operators) and not (Inbuff[i] = ' ') then Begin Writeln('Found invalid operator: ',Inbuff[i]); valid:= false End; i:= i + 1; End; {While loop to parse string.} if expdigit = true then Begin if isneg then temp:= temp * -1; B[j].opnd:= ConvReal(temp,NumDecPnt); j:= j + 1; expdigit := false; expdec := false; NumDecPnt:= 0; isneg:= false End; End; {First if valid loop. Next one won't run if invalid operator} if valid then Begin lenexp:= j - 1; {Length of converted expression} writeln; for i:= 1 to lenexp do Begin if B[i].oper = ' ' then write(B[i].opnd:2:3) else write(B[i].oper); write(' ') End; {Ready to create postfix expression in array C } A.top:= 0; j:= 0; for i:= 1 to lenexp do Begin {writeln('i = ',i);} if B[i].oper = ' ' then Begin j:= j + 1; C[j].opnd:= B[i].opnd End else Begin openok := true; while (not empty(A) and openok and pri(A.item[A.top],B[i].oper)) do Begin HoldTop:= pop(A); if HoldTop = '(' then openok:= false else Begin j:= j + 1; C[j].oper:=HoldTop End End; if B[i].oper ')' then
push(A,B[i].oper);
End; {Else}
End; {For loop}
while not empty(A) do
Begin
HoldTop:= pop(A);
if HoldTop '(' then
Begin
j:= j + 1;
C[j].oper:=HoldTop
End
End;
lenexp:= j; {Since parenthesis are not included in postfix.}
for i:= 1 to lenexp do
Begin
if C[i].oper = ' ' then
write(C[i].opnd:2:3)
else
write(C[i].oper);
write(' ')
End;
{The following evaluates the expression in the real stack}
D.top:=0;
for i:= 1 to lenexp do
Begin
if C[i].oper = ' ' then
Rpush(D,C[i].opnd)
else
Begin
opnd2:= Rpop(D);
opnd1:= Rpop(D);
result:= ROper(opnd1,opnd2,C[i].oper);
Rpush(D,result)
End {else}
End; {for loop}
result:= Rpop(D);
if Rempty(D) then
writeln(' = ',result:2:3)
else
writeln(' Could not evaluate',chr(7))
End;
Readln(Inbuff);
len:= length(Inbuff)
until len = 0
End.