'===========================================================================
' Subject: INFIX EXPRESSION EVALUATOR        Date: 08-17-97 (02:58)       
' Author:  J. W. Dare                        Code: QB, QBasic, PDS        
' Origin:  jwdare@novia.net                Packet: ALGOR.ABC
'===========================================================================
'Filename: MATH1.BAS
'QBasic/QB4.5
'jwdare@novia.net
'
'MATH1.BAS is a mathematical expression evaluator which converts an Infix
'(standard calculator) expression to a Postfix expression and then solves
'the equation.  The program is capable of handling the main arithmetic
'operations along with exponents, basic trig functions, the Pi constant,
'and one variable (X).  The input is case insensitive.
'Valid operators are:
'
'                +,  -,  * , /,  ^, SIN, COS, TAN, PI, and X for variable
'
'Negative numbers must be enclosed in parentheses, for example (-5) or
'(-(2+X)).  Commas are allowed in numeric expressions, for example
'987,654,321 is valid.  White space in input expression is ignored.
'
'The program uses MS Basic conventions such as disallowing raising any
'negative number to a non-integer power.   The program may be modified to
'alter these conventions.
'
'Math1.bas takes an input mathematical expression string, Math.in$.  The
'Subroutine Prep then "standardizes" the string.  The standardized Math.in$
'is then passed to the Subroutine Postfix which converts Math.in$ to the
'Postfix expression Math.fix$.  Math.fix$ is then passed to the Subroutine
'Calc which  evaluates the Postfix expression.
'
'Most of the following routines could be optimized by using the ASC function
'to convert ASCII characters to their numeric value and then doing integer
'comparisons.
'
'--------------- Program error codes
'
'     ERROR.CODE% =
'0 = NO DETECTED ERRORS
'1 = SYNTAX ERROR
'2 = PARENTHESES MISCOUNT
'3 = DIVISION BY 0 ERROR
'4 = RAISE NEG NUMBER TO NON-INTEGER POWER (SQR ROOT OF NEG NUMBER, ECT..)
'5 = DISALLOWED CHARACTER
'6 = DECIMAL POINT ERROR
'-----------------------------------------
'The main module variables are:
'        Math.in$ = The input expression
'        Math.fix$ = The Mathin$ expression converted to Postfix form
'        X = The user defined variable
'        Error.code% = 0 if no errors, otherwise contains error number
'        PFix.Stack$() = String array used in Sub Postfix
'        Val.Stack() =   Single precision array used in Sub Calc
'        Pi = 4 * ATN(1), the value of Pi
'        Deg.flg% = -1 if input angles are in degrees, 0 if in radians
'-----------------------------------------


DECLARE FUNCTION PrepString$ (Pstr$)
   'Used in SUB Prep
   'Converts lcase to ucase, removes spaces and commas
   'Converts negation to CHR$(22)

DECLARE SUB Functnams (Math.In$, Math.test$, Fun$, Char$)
   'Used in SUB Prep
   'Replaces multiple character function names with
   'single representitive character and creates string for
   'illegal character detection.

DECLARE FUNCTION Parenth.Cnt% (Cnt.str$)
   '0 if "(" and ")" count equal

DECLARE FUNCTION Legal.Char% (Strin$)
   'Used in SUB prep to check for invalid characters.

DECLARE FUNCTION String.Priority% (Test.Char$)
    'Used in SUB Postfix
    'Determines currently scanned character's priority value
    'Test.Char$ = Current Math.fix$ character

DECLARE FUNCTION Stack.Priority% (Test.Char$)
    'Used in SUB Postfix
    'Determines the priority value of operators stored in the stack
    'Test.Char$ = Top stack character

DECLARE FUNCTION Decim.Cnt% (Strin$)
    'Used in SUB Calc to test for correct number (1) of
    'decimal points in a numaric string (Val.tmp$).

DECLARE SUB Prep (Strin$, Error.Code%)
DECLARE SUB Postfix (Math.In$, Math.Fix$, PFix.Stack$())
DECLARE SUB Calc (Math.Fix$, Val.Stack(), X, Final.val, Error.Code%, Deg.flg%, Pi)


DIM Val.Stack(50)    'picked 50 arbitrarily
DIM PFix.Stack$(50)
Pi = 4 * ATN(1)
Error.Code% = 0

'--------- Test input

Deg.flg% = -1     '-1 for degree calculations, 0 for radian calculations.
X = 5             'Set to any value for testing use of a variable.

LINE INPUT "Enter an expression: "; Math.In$


'-------------- Main module
IF LEN(Math.In$) THEN
   CALL Prep(Math.In$, Error.Code%)
   IF Error.Code% = 0 THEN
      CALL Postfix(Math.In$, Math.Fix$, PFix.Stack$())
     
         'The Sub Calc may be placed in a loop to solve for
         'multiple values of X
      CALL Calc(Math.Fix$, Val.Stack(), X, Final.val, Error.Code%, Deg.flg%, Pi)
  
   END IF
ELSE
   Error.Code% = 5
END IF

'-------------- Test output
PRINT
PRINT "Math.In$ = "; Math.In$
PRINT "Math.fix$ = "; Math.Fix$
PRINT

   IF Error.Code% = 0 THEN
      PRINT "Final.val ="; Final.val
   ELSE
      PRINT "Error code #"; LTRIM$(STR$(Error.Code%))
   END IF
PRINT

END

'        The Calc subroutine is used to solve the Postfix expression
'Math.Fix$.  This is accomplished by scanning Math.Fix$ one character at a
'time, from left to right.  Operands and temporary results are store in the
'single precision array, Val.Stack(), which is a stack addressed by
'Valstk.pntr%.
'        Numeric string characters are stored in a temporary variable
'(Val.Temp$) until a comma is encountered.  The comma signals the program
'to increment the pointer,  convert the numeric string to a single
'precision numeric value, then store the numeric value in the top position
'of Val.Stack().  Likewise, constants and the value contained in the
'variable (X) are stored on the top of the stack when encountered.
'        If an operator that only requires one operand such as trig
'functions or negation, is scanned, the function/operation is applied to
'the top value in the stack.  If an operator requiring two operators such
'as addition, subtraction, multiplication, or division, is the current
'scanned character, the top value is pulled from the stack, the stack
'pointer is decremented by one, and that value is also pulled from the stack.
'The operation is performed on these two operands and then the results of
'the operation is stored in the current stack position.
'
SUB Calc (Math.Fix$, Val.Stack(), X, Final.val, Error.Code%, Deg.flg%, Pi)
   Valstk.pntr% = 0
   Val.tmp$ = ""
   Co.ef1 = 0
   Co.ef2 = 0
   Test.str1$ = "0123456789."       'numerics
   Test.str2$ = "SCT"               'functions
FOR i% = 1 TO LEN(Math.Fix$)
  
   Crnt.Char$ = MID$(Math.Fix$, i%, 1)
  
   IF INSTR(Test.str1$, Crnt.Char$) THEN
      Val.tmp$ = Val.tmp$ + Crnt.Char$
   ELSEIF INSTR(Test.str2$, Crnt.Char$) THEN
      IF Deg.flg% THEN              'Convert degree input to radian
         Val.Stack(Valstk.pntr%) = Val.Stack(Valstk.pntr%) * Pi / 180
      END IF
     
      IF Crnt.Char$ = "S" THEN
         Val.Stack(Valstk.pntr%) = SIN(Val.Stack(Valstk.pntr%))
      ELSEIF Crnt.Char$ = "C" THEN
         Val.Stack(Valstk.pntr%) = COS(Val.Stack(Valstk.pntr%))
      ELSEIF Crnt.Char$ = "T" THEN
         Val.Stack(Valstk.pntr%) = TAN(Val.Stack(Valstk.pntr%))
      END IF
   ELSE
      IF Crnt.Char$ = "," THEN
         Error.Code% = Decim.Cnt%(Val.tmp$)  'Test for multiple decimal points
         IF Error.Code% = 0 THEN
            Valstk.pntr% = Valstk.pntr% + 1
            Val.Stack(Valstk.pntr%) = VAL(Val.tmp$)   'Add number to stack
            Val.tmp$ = ""
         ELSE
            EXIT FOR
         END IF
      ELSEIF Crnt.Char$ = "P" THEN
         Valstk.pntr% = Valstk.pntr% + 1
         Val.Stack(Valstk.pntr%) = Pi
      ELSEIF Crnt.Char$ = "X" THEN
         Valstk.pntr% = Valstk.pntr% + 1
         Val.Stack(Valstk.pntr%) = X
      ELSEIF Crnt.Char$ = CHR$(22) THEN
         Val.Stack(Valstk.pntr%) = -Val.Stack(Valstk.pntr%)
      ELSEIF Crnt.Char$ = "*" THEN
         Co.ef2 = Val.Stack(Valstk.pntr%)
            Valstk.pntr% = Valstk.pntr% - 1
         Co.ef1 = Val.Stack(Valstk.pntr%)
         Val.Stack(Valstk.pntr%) = Co.ef1 * Co.ef2
      ELSEIF Crnt.Char$ = "/" THEN
         Co.ef2 = Val.Stack(Valstk.pntr%)
         IF Co.ef2 <> 0 THEN                       'Test for divide by 0
               Valstk.pntr% = Valstk.pntr% - 1
            Co.ef1 = Val.Stack(Valstk.pntr%)
            Val.Stack(Valstk.pntr%) = Co.ef1 / Co.ef2
         ELSE
            Error.Code% = 3
            EXIT FOR
         END IF
      ELSEIF Crnt.Char$ = "+" THEN
         Co.ef2 = Val.Stack(Valstk.pntr%)
            Valstk.pntr% = Valstk.pntr% - 1
         Co.ef1 = Val.Stack(Valstk.pntr%)
         Val.Stack(Valstk.pntr%) = Co.ef1 + Co.ef2
      ELSEIF Crnt.Char$ = "-" THEN
         Co.ef2 = Val.Stack(Valstk.pntr%)
            Valstk.pntr% = Valstk.pntr% - 1
         Co.ef1 = Val.Stack(Valstk.pntr%)
         Val.Stack(Valstk.pntr%) = Co.ef1 - Co.ef2
      ELSEIF Crnt.Char$ = "^" THEN
         Co.ef2 = Val.Stack(Valstk.pntr%)
            Valstk.pntr% = Valstk.pntr% - 1
         Co.ef1 = Val.Stack(Valstk.pntr%)
         Pwr.tmp = Co.ef2 - FIX(Co.ef2)       'test for non-integer value
         IF Co.ef1 < 0 AND Pwr.tmp <> 0 THEN
            Error.Code% = 4
            EXIT FOR
         ELSE
            Val.Stack(Valstk.pntr%) = Co.ef1 ^ Co.ef2
         END IF
      END IF
   END IF
NEXT i%

IF Error.Code% = 0 THEN
   IF Valstk.pntr% = 1 THEN         'Program has reached bottom of stack
      Final.val = Val.Stack(Valstk.pntr%)
   ELSE
      Error.Code% = 1               'Probable input syntax error
   END IF
END IF

END SUB

'Makes sure there's only one decimal point in Strin$, returns error #6 if
'multiple decimal points exits in a numeric exprssion (input error checking.)
'
FUNCTION Decim.Cnt% (Strin$)
   flag% = 0
   Position% = 1
   Test% = 0
   Decim.Cnt% = 0
   DO
      Test% = INSTR(Position%, Strin$, ".")
      IF Test% THEN
         IF flag% THEN
            Decim.Cnt% = 6
            EXIT DO
         ELSE
            Position% = Test% + 1
            flag% = NOT flag%
         END IF
      END IF
   LOOP UNTIL Test% = 0

END FUNCTION

'Replaces Math.in$ function names with single representitive character.
'Math.test$ is a control used by the Legal.Char%() function to check for
'invalid characters later in Sub Prep
'
SUB Functnams (Math.In$, Math.test$, Fun$, Char$)
DO
   Place% = INSTR(Math.In$, Fun$)
   IF Place% THEN
     
      Str.1$ = LEFT$(Math.In$, (Place% - 1))
      Str.2$ = RIGHT$(Math.In$, (LEN(Math.In$) - (LEN(Str.1$) + LEN(Fun$))))
      Math.In$ = Str.1$ + Char$ + Str.2$
     
      'Used by function Legal.Char%() for input error testing
      Str.1test$ = LEFT$(Math.test$, (Place% - 1))
      Str.2test$ = RIGHT$(Math.test$, (LEN(Math.test$) - (LEN(Str.1$) + LEN(Fun$))))
      Math.test$ = Str.1test$ + SPACE$(1) + Str.2test$
   END IF
LOOP WHILE Place%
END SUB

'Tests a control string for invalid characters (input error checking.)
'Returns error #5 if error detected.
'
FUNCTION Legal.Char% (Strin$)
   Test.str$ = "01234567890.X()+-*/^ " + CHR$(22)
   flag% = 0
   Cnt% = 0
   DO
      Cnt% = Cnt% + 1
      IF INSTR(Test.str$, MID$(Strin$, Cnt%, 1)) = 0 THEN flag% = 1
   LOOP UNTIL Cnt% = LEN(Strin$) OR flag%
   IF flag% THEN
      Legal.Char% = 5
   ELSE
      Legal.Char% = 0
   END IF
   
END FUNCTION

'Counts parentheses, returns an error #2 if parentheses miscount occurs (input
'error checking.)
'
FUNCTION Parenth.Cnt% (Cnt.str$)
   Open.Parcnt% = 0
   Close.Parcnt% = 0
   FOR i% = 1 TO LEN(Cnt.str$)
      IF MID$(Cnt.str$, i%, 1) = "(" THEN
         Open.Parcnt% = Open.Parcnt% + 1
      ELSEIF MID$(Cnt.str$, i%, 1) = ")" THEN
         Close.Parcnt% = Close.Parcnt% + 1
      END IF
      IF Close.Parcnt% > Open.Parcnt% THEN EXIT FOR
   NEXT i%
   IF (Open.Parcnt% - Close.Parcnt%) THEN
      Parenth.Cnt% = 2
   ELSE
      Parenth.Cnt% = 0
   END IF
END FUNCTION

'Sub for converting infix (Math.In$) to postfix (Matfix$)
'        The Postfix subroutine contains the code that scans the Infix
'expression, Math.In$, and creates the Postfix (polish notation) expression
'Math.Fix$.  Postfix expressions differ from standard Infix expressions in
'that the math operator follows the two operands instead of being placed
'between them, and also, parentheses are not needed.  The use of comma
'delimiters is my own embellishment.
'For example:
'
'    Infix:                  Postfix:
'    -----------             -------------
'    3+2                     3,2,+
'    (3+2)*(6-5)             3,2,+6,5,-*
'    2^8/256                 2,8,^256,/
'
'       This is done with the use of two functions, String.Priority%() and
'Stack.Priority%(), and the PFix.Stack$ array which serves as a stack to
'store mathematical operators.
'        The Math.In$ string is scanned, left to right.  Each scanned
'number is added directly to the right end of Math.Fix$, with a comma added
'to the end of each complete numeric expression.  Constants and variables are
'added directly to the right end of Math.Fix$ also, but no trailing comma is
'added.  The trailing comma after each numeric expression is used by the
'Calc subroutine as an "end of numeric string" flag.
'        The two functions are used to determine the "priority" of scanned
'operators or parentheses.  String.Priority%() assigns a priority value to
'the currently scanned Math.In$ operator.  Stack.Priority%() assigns a
'value to operators stored in the PFix.Stack$ array.  Their priority
'values are:
'
'    Operator                String.Priority%()      Stack.Priority%()
'    --------                ------------------      -----------------
'    (                       0                       6
'    Trig Function           1                       1
'    Negative  number        2                       2
'    ^                       3                       3
'    * or /                  4                       4
'    + or -                  5                       5
'
'        If the scanned character is an operator or opening parenthesis
'then the priority of the top operator on the stack is checked.  If the
'stack operator's Stack.Priority% is equal or less than the currently
'scanned operator's String.Priority% then the stack operator is added to
'the right end of Math.Fix$, the stack pointer (PfixStk.Pntr%) is decremented
'by one, and the next operator on the stack is compared to the currently
'scanned operator.  When the Stack.Priority% value of the top stack
'operator is greater than the String.Priority% of the currently scanned
'operator, then the stack pointer is incremented by one and the currently
'scanned operator is added to the stack.
'        If the scanned operator is a closing parenthesis, then each stack
'operator is pulled off the stack and added to the right of Math.Fix$ until
'an opening parenthesis is encountered in the stack.  After the last
'Math.In$ character is scanned and processed, any remaining operators in
'the stack are pulled one at a time and added to the right end of Math.Fix$.
'
'note, CHR$(22) denotes a negative number
'
SUB Postfix (Math.In$, Math.Fix$, PFix.Stack$())
   true% = -1
   false% = NOT true%
   Crnt.Char$ = ""
   Test.str1$ = "0123456789."
   Test.str2$ = "+-*/^SCT()XP" + CHR$(22)
   Begin.num% = true%
   PfixStk.Pntr% = 0
   Math.Fix$ = ""

FOR i% = 1 TO LEN(Math.In$)
   Crnt.Char$ = MID$(Math.In$, i%, 1)
  
   IF INSTR(Test.str1$, Crnt.Char$) THEN           'Process numerics
      Math.Fix$ = Math.Fix$ + Crnt.Char$
      Begin.num% = false%
   ELSEIF INSTR(Test.str2$, Crnt.Char$) THEN
     
      IF NOT Begin.num% THEN
         Math.Fix$ = Math.Fix$ + ","
         Begin.num% = true%
      END IF
     
      IF Crnt.Char$ = "X" OR Crnt.Char$ = "P" THEN 'Process constants/variables
         Math.Fix$ = Math.Fix$ + Crnt.Char$
      ELSE                                         'Process operators
         repeat% = true%
         DO
            IF Crnt.Char$ = ")" THEN
               IF PFix.Stack$(PfixStk.Pntr%) = "(" THEN
                  repeat% = false%
               ELSE
                  Math.Fix$ = Math.Fix$ + PFix.Stack$(PfixStk.Pntr%)
               END IF
               PfixStk.Pntr% = PfixStk.Pntr% - 1
            ELSE
               IF Stack.Priority%(PFix.Stack$(PfixStk.Pntr%)) <= String.Priority%(Crnt.Char$) AND PfixStk.Pntr% > 0 THEN
                  Math.Fix$ = Math.Fix$ + PFix.Stack$(PfixStk.Pntr%)
                  PfixStk.Pntr% = PfixStk.Pntr% - 1
               ELSE
                  PfixStk.Pntr% = PfixStk.Pntr% + 1
                  PFix.Stack$(PfixStk.Pntr%) = Crnt.Char$
                  repeat% = false%
               END IF
            END IF
         LOOP WHILE repeat%
      END IF
  
   END IF
NEXT i%
  
IF NOT Begin.num% THEN Math.Fix$ = Math.Fix$ + ","
     
      'Add any remaining operators to Math.Fix$
DO UNTIL PfixStk.Pntr% = 0
   Math.Fix$ = Math.Fix$ + PFix.Stack$(PfixStk.Pntr%)
   PfixStk.Pntr% = PfixStk.Pntr% - 1
LOOP

END SUB

'        The Prep subroutine prepares the Math.In$ string for later
'evaluation by the Postfix subroutine.
'        First, Math.In$ is passed to the Prepstring$ function which
'removes spaces and commas, and assigns CHR$(22) to denote negative
'numbers.  It also converts all letters to upper case.  Math.In$ is then
'checked for proper parentheses count by the Parenth.Cnt% function.
'       Next, Math.In$ is passed to a series of the subroutine Functnams
'which replaces function names such a "SIN" with a single representative
'character, in this case "S".  The sub Functnams also creates a test string,
'Math.Test$, which is scanned by the Legal.Char% function for remaining
'invalid characters.
'
SUB Prep (Math.In$, Error.Code%)
   Math.In$ = PrepString$(Math.In$)
   Error.Code% = Parenth.Cnt%(Math.In$)
   IF Error.Code% = 0 THEN
      Math.test$ = Math.In$
      CALL Functnams(Math.In$, Math.test$, "SIN", "S")
      CALL Functnams(Math.In$, Math.test$, "COS", "C")
      CALL Functnams(Math.In$, Math.test$, "TAN", "T")
      CALL Functnams(Math.In$, Math.test$, "PI", "P")
      Error.Code% = Legal.Char%(Math.test$)
   END IF
END SUB

'Removes spaces and commas from input string, converts negation to a CHR$(22),
'and converts all letters to upper case.
'
FUNCTION PrepString$ (Pstr$)
   Pstr.tmp$ = ""
   Prev.b$ = ""
   FOR i% = 1 TO LEN(Pstr$)
      b$ = MID$(Pstr$, i%, 1)
      IF b$ <> " " AND b$ <> "," THEN
         IF b$ = "-" AND Prev.b$ = "(" THEN b$ = CHR$(22)
         Pstr.tmp$ = Pstr.tmp$ + b$
      END IF
      Prev.b$ = b$
   NEXT i%
   PrepString$ = UCASE$(Pstr.tmp$)
END FUNCTION

'Determines the priority value of the current operator from the stack.
'
FUNCTION Stack.Priority% (Test.Char$)
   IF Test.Char$ = "(" THEN
      Stack.Priority% = 6
   ELSEIF Test.Char$ = "S" OR Test.Char$ = "C" OR Test.Char$ = "T" THEN
      Stack.Priority% = 1
   ELSEIF Test.Char$ = CHR$(22) THEN
      Stack.Priority% = 2
   ELSEIF Test.Char$ = "^" THEN
      Stack.Priority% = 3
   ELSEIF Test.Char$ = "*" OR Test.Char$ = "/" THEN
      Stack.Priority% = 4
   ELSEIF Test.Char$ = "+" OR Test.Char$ = "-" THEN
      Stack.Priority% = 5
   END IF
END FUNCTION

'Determines the priority of the current Math.Fix$ test character.
'
FUNCTION String.Priority% (Test.Char$)
   IF Test.Char$ = "(" THEN
      String.Priority% = 0
   ELSEIF Test.Char$ = "S" OR Test.Char$ = "C" OR Test.Char$ = "T" THEN
      String.Priority% = 1
   ELSEIF Test.Char$ = CHR$(22) THEN
      String.Priority% = 2
   ELSEIF Test.Char$ = "^" THEN
      String.Priority% = 3
   ELSEIF Test.Char$ = "*" OR Test.Char$ = "/" THEN
      String.Priority% = 4
   ELSEIF Test.Char$ = "+" OR Test.Char$ = "-" THEN
      String.Priority% = 5
   END IF
END FUNCTION