'===========================================================================
' Subject: RPN POSTFIX NOTATION EVAULATOR     Date: 01-28-97 (14:30)       
'  Author: The ABC Programmer                 Code: QB, QBasic, PDS        
'  Origin: voxel@freenet.edmonton.ab.ca     Packet: ALGOR.ABC
'===========================================================================
'=========================================================================
' Reverse Polish Notation (RPN) Evaluator Programmed by William Yu (01/97)
'
'            Infix Notation : 4 + (3 - 2) * 9 ^ 2
'   Equivalent Postfix (RPN): 4 3 2 - 9 2 ^ * +
'
' Please check ALGOR.ABC for the useful INFIX TO POSTFIX (RPN) CONVERTER.
' Both demonstrate the fundamentals and uses of stacks.
'=========================================================================

DECLARE FUNCTION EmptyStack% (Stack AS INTEGER)
DECLARE SUB POP (Stack AS INTEGER, Element AS DOUBLE)
DECLARE SUB GetNextToken (RPNExp AS STRING, Position AS INTEGER, Token AS ANY, TokenItem AS STRING)
DECLARE SUB PUSH (Stack AS INTEGER, Element AS DOUBLE)
DECLARE FUNCTION Evaluate# (RPNExp AS STRING)
DEFINT A-Z

CONST FALSE = 0
CONST TRUE = NOT FALSE

' Token item
CONST Operand = 1         ' TIP: Use descriptive identifiers };-)
CONST Operator = 2        ' So you don't have to waste time documenting.
CONST Bad = 3
CONST Finished = 4

'Error codes
CONST None = 0
CONST FewOperands = 1
CONST FewOperator = 2
CONST Invalid = 3
CONST NoResult = 4

CONST Max = 100      ' # of items (operands only) to fill stack until full

DIM RPNExp AS STRING
DIM SHARED Element(1 TO Max) AS DOUBLE
DIM SHARED ErrorCode

' One heck of an expression :)
' Needs
'WIDTH 80, 43
' to view all the steps
' End the expression with ; (semi-colon)

RPNExp = "+4.546 2.6734^ 5656 -438.390 /* 6234  -234 99*564- 23 432 457 234 *+/*-+;"

' Other examples to uncomment.  Create one!
'RPNExp = "4 6 +;"
'RPNExp = "-34.3 345 / 345 -345* 45 +-;"
'RPNExp = "45.345 -.345*;"
'RPNExp = "34 8 ^ 85 10 + *;"

CLS
PRINT "Expression is: "; RPNExp

Number# = Evaluate(RPNExp)
IF ErrorCode = None THEN
  PRINT "Expression Value is:"; Number#
ELSE
  PRINT : PRINT "*** BAD EXPRESSION : ";
  SELECT CASE ErrorCode
    CASE FewOperands
      PRINT "Too few operands. ***"
    CASE FewOperator
      PRINT "Too few operators. ***"
    CASE Invalid
      PRINT "Invalid input (bad character) ***"
    CASE NoResult
      PRINT "Nothing to evaluate! ***"
  END SELECT
END IF

FUNCTION EmptyStack (Stack AS INTEGER)
'----------------------------------------------
'  Simply checks if stack is empty
'----------------------------------------------

  EmptyStack = FALSE
  IF Stack = 0 THEN EmptyStack = TRUE

END FUNCTION

FUNCTION Evaluate# (RPNExp AS STRING)
'----------------------------------------------
'  Evaluate the RPN Expression
'----------------------------------------------

DIM TokenItem AS STRING
DIM Number AS DOUBLE, Number2 AS DOUBLE

   Position = 1      ' Parse string from position 1
   Stack = 0         ' Initialize Stack, ie. make it empty
   ErrorCode = None

   DO
     GetNextToken RPNExp, Position, Token, TokenItem
     PRINT "TOKEN = "; TokenItem;
     SELECT CASE Token
       CASE Operand
         Number = VAL(TokenItem)
         PRINT "  PUSH = "; Number
         PUSH Stack, Number
       CASE Operator
         POP Stack, Number
         IF EmptyStack(Stack) THEN ErrorCode = FewOperands: EXIT DO
         POP Stack, Number2
         PRINT "  POP ="; Number; " POP ="; Number2
         SELECT CASE TokenItem
           CASE "+"
             Number = Number + Number2
           CASE "-"
             Number = Number2 - Number
           CASE "*"
             Number = Number * Number2
           CASE "/"
             Number = Number2 / Number
           CASE "^"
             Number = Number2 ^ Number
         END SELECT
         PUSH Stack, Number
         PRINT " PUSH ="; Number
       CASE Finished
         IF EmptyStack(Stack) THEN
           ErrorCode = NoResult
         ELSE
           POP Stack, Number
           PRINT " POP ="; Number
         END IF
       CASE Bad
         ErrorCode = Invalid
         EXIT DO
     END SELECT
   LOOP UNTIL Token = Finished
   IF NOT EmptyStack(Stack) THEN ErrorCode = FewOperator

   Evaluate# = Number

END FUNCTION

SUB GetNextToken (RPNExp AS STRING, Position AS INTEGER, Token AS INTEGER, TokenItem AS STRING)
'------------------------------------------------------------------------
'  Parse Expression until a token (Operand/Operator/EndOfExpr) is found.
'------------------------------------------------------------------------

  Start = Position
  Done = FALSE
  Token = Finished
  Numbers$ = "0123456789."
  Signs$ = " +-*/^"

  DO
    Char$ = MID$(RPNExp, Position, 1)
    SELECT CASE Char$
      CASE "0" TO "9", "."
        Token = Operand
        Check$ = MID$(RPNExp, Position + 1, 1)
        Check = FALSE
        FOR I = 1 TO LEN(Signs$)
          IF Check$ = MID$(Signs$, I, 1) THEN Check = TRUE
        NEXT I
        IF Check THEN Done = TRUE
      CASE " "
        Start = Start + 1
      CASE "+", "-"
        Check$ = MID$(RPNExp, Position + 1, 1)
        Check = FALSE
        FOR I = 1 TO LEN(Numbers$)
          IF Check$ = MID$(Numbers$, I, 1) THEN Check = TRUE
        NEXT I
        IF Check THEN                   ' Check for strings like 123+123
          IF Token = Operand THEN       ' which is not valid.
            Token = Bad                 ' (Where + can be any operator)
            Done = TRUE
          ELSE                          ' Although you can have -123
            Token = Operand             ' so we continue to parse...
          END IF
        ELSE                            ' Else it's 123+ or just +
          Token = Operator              ' So we perform the operation.
          Done = TRUE                   ' (Again, + can be any operator)
        END IF
      CASE "*", "/", "^"
        Token = Operator
        Done = TRUE
      CASE ";"
        Done = TRUE
        Token = Finished
      CASE ELSE
        Token = Bad
        Done = TRUE
    END SELECT
    Position = Position + 1
  LOOP UNTIL Done OR Position > LEN(RPNExp)
 
  TokenItem = MID$(RPNExp, Start, Position - Start)

END SUB

SUB POP (Stack AS INTEGER, Element AS DOUBLE)
'----------------------------------------------
'  Return the top element on the stack.
'----------------------------------------------

IF Stack = 0 THEN
  PRINT " *** Attempt to pop from an empty stack ***"
ELSE
  Element = Element(Stack)
  Stack = Stack - 1
END IF

END SUB

SUB PUSH (Stack AS INTEGER, Element AS DOUBLE)
'----------------------------------------------
'  Fill stack with Element
'----------------------------------------------

Stack = Stack + 1
IF Stack > Max THEN
  PRINT " *** Attempt to push on a full stack ***"
ELSE
  Element(Stack) = Element
END IF

END SUB