Operator Precedence Parsing (Expression Parser)

yetifoot · Post by **yetifoot** » Sep 09, 2006 13:36

I found this quite interesting, as its quite a different method to many others I have seen, and can seemingly be easily customized for particular precedences, it also has commands for factorials, permutations, and combinations, which I haven't seen much in this type of code before.

Code: Select all

' Tom Niemanns Operator Precedence Parsing. (Shift and reduce technique)
' (Laymans Terms : Expression parser)
' A conversion from his VB code.
' More information from http://www.epaperpress.com/oper/index.html

' Note : This is very fussy about everything being space delimited
'        see the quick tests at the bottom.

#undef Error

Option Explicit

' actions
Enum ActionEnum
  S                  ' shift
  R                  ' reduce
  A                  ' accept
  E1                 ' error: missing right parenthesis
  E2                 ' error: missing operator
  E3                 ' error: unbalanced right parenthesis
  E4                 ' error: invalid function argument
End Enum

' tokens
Enum tokEnum
  ' operators
  tAdd                ' +
  tSub                ' -
  tMul                ' *
  tDiv                ' /
  tPow                ' ^ (power)
  tUmi                ' - (unary minus)
  tFact               ' f(x): factorial
  tPerm               ' p(n,r): permutations, n objects, r at a time
  tComb               ' c(n,r): combinations, n objects, r at a time
  tComa               ' comma
  tLpr                ' (
  tRpr                ' )
  tEof                ' end of string
  tMaxOp              ' maximum number of operators
  ' non-operators
  tVal                ' value
End Enum

Dim Shared Tok As tokEnum          ' token
Dim Shared Tokval As Double        ' token value

Const MaxOpr As Integer = 50
Const MaxV As Integer = 50

Dim Shared Opr(MaxOpr) As Integer      ' operator stack
Dim Shared V(MaxV) As Double           ' value stack
Dim Shared OprTop As Integer           ' top of operator
Dim Shared VTop As Integer             ' value stack
Dim Shared Term() As String            ' array of terms
Dim Shared TermIndex As Integer        ' current term
    
Dim Shared ParseTbl(tMaxOp, tMaxOp) As Byte

Function IsNumeric(st As String) As Integer
  Dim c As Integer
  Dim i As Integer
    For i = 0 To Len(st) - 1
      c = st[i]
      If (c < Asc("0")) OR (c > Asc("9")) Then 
        Return 0
      End If
    Next i
    Return -1
End Function

''::::: V1CTORS SPLIT ROUTINE FROM freebasic.net FORUM
Function split(src As String, _
               del As String, _
               res() As String) As Integer

Const MAXDELIMITERS = 256       
       
        Dim As Integer char, d, i, s1, l
        Dim As Integer delpos(0 To MAXDELIMITERS+1)

        char = Asc( del )

        '' find all delimiters
        d = 0
        delpos(d) = 0
        For i = 0 To Len( src )-1
                If src[i] = char Then
                        d += 1
                        If( d > MAXDELIMITERS ) Then
                                Exit For
                        End If
                        delpos(d) = i + 1
                End If
        Next
       
        '' allocate the result array
        Redim res(0 To d)
       
        If( d = 0 ) Then
                res(0) = src
                Return 1
        End If
               
        '' copy strings
        delpos(d+1) = Len( src ) + 1
        For i = 0 To d

                s1 = delpos(i) + 1
                l = delpos(i+1) - s1
                If( l > 0 ) Then
                        res(i) = Mid$( src, s1, l )
                End If
               
        Next

        Function = d + 1
       
End Function

Function Error(msg As String) As Integer
  Print ("Error: " & msg)
  Error = 1
End Function

Function GetTok() As Integer
  Dim TokStr As String
  Static PrevTok As tokEnum
      
    ' get next token
    GetTok = 0
    TermIndex = TermIndex + 1
    If TermIndex > UBound(Term) Then
      Tok = tEof
      Exit Function
    End If
        
    TokStr = Term(TermIndex)

    ' convert symbol to token
    Select Case TokStr
    Case "+": Tok = tAdd
    Case "-": Tok = tSub
    Case "*": Tok = tMul
    Case "/": Tok = tDiv
    Case "^": Tok = tPow
    Case "(": Tok = tLpr
    Case ")": Tok = tRpr
    Case ",": Tok = tComa
    Case "f": Tok = tFact
    Case "p": Tok = tPerm
    Case "c": Tok = tComb
    Case Else
      If IsNumeric(TokStr) Then
        Tokval = Val(TokStr)
        Tok = tVal
      Else
        Print ("token not numeric (" & TokStr & "), use spaces as separators")
        GetTok = 1
      End If
    End Select

    ' check for unary minus
    If Tok = tSub And TermIndex > 0 Then
      If PrevTok <> tVal And PrevTok <> tRpr Then
        Tok = tUmi
      End If
    End If

    PrevTok = Tok
End Function

Function Shift() As Integer
  If Tok = tVal Then
      VTop = VTop + 1
      If VTop >= MaxV Then
          Shift = Error("V stack exhausted")
          Exit Function
      End If
      V(VTop) = Tokval
  Else
      OprTop = OprTop + 1
      If OprTop >= MaxOpr Then
          Shift = Error("Opr stack exhausted")
          Exit Function
      End If
      Opr(OprTop) = Tok
  End If
  If GetTok() <> 0 Then
      Shift = 1
      Exit Function
  End If
  Shift = 0
End Function

Function Fact(N As Double) As Double
  Dim i As Double
  Dim res As Double
    res = 1#
    For i = 1 To N
      res = res * i
    Next i
    Return res
End Function

Function Reduce() As Integer
  Select Case Opr(OprTop)
    Case tAdd
      ' apply E := E + E
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = V(VTop - 1) + V(VTop)
      VTop = VTop - 1
    Case tSub
      ' apply E := E - E
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = V(VTop - 1) - V(VTop)
      VTop = VTop - 1
    Case tMul
      ' apply E := E * E
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = V(VTop - 1) * V(VTop)
      VTop = VTop - 1
    Case tDiv
      ' apply E := E / E
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = V(VTop - 1) / V(VTop)
      VTop = VTop - 1
    Case tUmi
      ' apply E := -E
      If VTop < 0 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop) = -V(VTop)
    Case tPow
      ' apply E := E ^ E
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = V(VTop - 1) ^ V(VTop)
      VTop = VTop - 1
    Case tFact
      ' apply E := f(E)
      If VTop < 0 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop) = Fact(V(VTop))
    Case tPerm
      ' apply E := p(N,R)
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = Fact(V(VTop - 1)) / Fact(V(VTop - 1) - V(VTop))
      VTop = VTop - 1
    Case tComb
      ' apply E := c(N,R)
      If VTop < 1 Then
          Reduce = Error("Syntax error")
          Exit Function
      End If
      V(VTop - 1) = Fact(V(VTop - 1)) / _
          (Fact(V(VTop)) * Fact(V(VTop - 1) - V(VTop)))
      VTop = VTop - 1
    Case tRpr
      ' pop () off stack
      OprTop = OprTop - 1
  End Select
  OprTop = OprTop - 1
  Reduce = 0
End Function

Sub Parse(Expr As String)

  ' initialize for next expression
  OprTop = 0
  VTop = -1
  Opr(OprTop) = tEof
  TermIndex = -1
  
  Split(Expr, " ", Term())
  If GetTok() <> 0 Then Exit Sub

  Do
    ' input is Vue
    If Tok = tVal Then
      ' shift token to value stack
      If Shift() <> 0 Then Exit Sub
    Else

      ' input is operator
      Select Case ParseTbl(Opr(OprTop), Tok)
        Case R
          If Reduce() <> 0 Then Exit Sub
        Case S
          If Shift() <> 0 Then Exit Sub
        Case A
          ' accept
          If VTop = 0 Then
              Print "value = " & V(0)
          Else
              Error ("Syntax error")
          End If
          Exit Sub
        Case E1
          Error ("Missing right parenthesis")
          Exit Sub
        Case E2
          Error ("Missing operator")
          Exit Sub
        Case E3
          Error ("Unbalanced right parenthesis")
          Exit Sub
        Case E4
          Error ("Invalid function argument")
          Exit Sub
      End Select
    End If
  Loop
End Sub

Sub Test(Expr As String)
  Call Parse(Expr)
End Sub

Sub Init()

  ' stk  ------------------ input ------------------------
  '      +   -   *   /   ^   M   f   p   c   ,   (   )   $
  '      --  --  --  --  --  --  --  --  --  --  --  --  --
  ' +  { R,  R,  S,  S,  S,  S,  S,  S,  S,  R,  S,  R,  R },
  ' -  { R,  R,  S,  S,  S,  S,  S,  S,  S,  R,  S,  R,  R },
  ' *  { R,  R,  R,  R,  S,  S,  S,  S,  S,  R,  S,  R,  R },
  ' /  { R,  R,  R,  R,  S,  S,  S,  S,  S,  R,  S,  R,  R },
  ' ^  { R,  R,  R,  R,  S,  S,  S,  S,  S,  R,  S,  R,  R },
  ' M  { R,  R,  R,  R,  R,  S,  S,  S,  S,  R,  S,  R,  R },
  ' f  { E4, E4, E4, E4, E4, E4, E4, E4, E4, E4, S,  R,  R },
  ' p  { E4, E4, E4, E4, E4, E4, E4, E4, E4, E4, S,  R,  R },
  ' c  { E4, E4, E4, E4, E4, E4, E4, E4, E4, E4, S,  R,  R },
  ' ,  { R,  R,  R,  R,  R,  R,  R,  R,  R,  E4, R,  R,  E4},
  ' (  { S,  S,  S,  S,  S,  S,  S,  S,  S,  S,  S,  S,  E1},
  ' )  { R,  R,  R,  R,  R,  R,  E3, E3, E3, E4, E2, R,  R },
  ' $  { S,  S,  S,  S,  S,  S,  S,  S,  S,  E4, S,  E3, A }
  
  ParseTbl(tAdd, tAdd) = R
  ParseTbl(tAdd, tSub) = R
  ParseTbl(tAdd, tMul) = S
  ParseTbl(tAdd, tDiv) = S
  ParseTbl(tAdd, tPow) = S
  ParseTbl(tAdd, tUmi) = S
  ParseTbl(tAdd, tFact) = S
  ParseTbl(tAdd, tPerm) = S
  ParseTbl(tAdd, tComb) = S
  ParseTbl(tAdd, tComa) = R
  ParseTbl(tAdd, tLpr) = S
  ParseTbl(tAdd, tRpr) = R
  ParseTbl(tAdd, tEof) = R
  
  ParseTbl(tSub, tAdd) = R
  ParseTbl(tSub, tSub) = R
  ParseTbl(tSub, tMul) = S
  ParseTbl(tSub, tDiv) = S
  ParseTbl(tSub, tPow) = S
  ParseTbl(tSub, tUmi) = S
  ParseTbl(tSub, tFact) = S
  ParseTbl(tSub, tPerm) = S
  ParseTbl(tSub, tComb) = S
  ParseTbl(tSub, tComa) = R
  ParseTbl(tSub, tLpr) = S
  ParseTbl(tSub, tRpr) = R
  ParseTbl(tSub, tEof) = R
  
  ParseTbl(tMul, tAdd) = R
  ParseTbl(tMul, tSub) = R
  ParseTbl(tMul, tMul) = R
  ParseTbl(tMul, tDiv) = R
  ParseTbl(tMul, tPow) = S
  ParseTbl(tMul, tUmi) = S
  ParseTbl(tMul, tFact) = S
  ParseTbl(tMul, tPerm) = S
  ParseTbl(tMul, tComb) = S
  ParseTbl(tMul, tComa) = R
  ParseTbl(tMul, tLpr) = S
  ParseTbl(tMul, tRpr) = R
  ParseTbl(tMul, tEof) = R
      
  ParseTbl(tDiv, tAdd) = R
  ParseTbl(tDiv, tSub) = R
  ParseTbl(tDiv, tMul) = R
  ParseTbl(tDiv, tDiv) = R
  ParseTbl(tDiv, tPow) = S
  ParseTbl(tDiv, tUmi) = S
  ParseTbl(tDiv, tFact) = S
  ParseTbl(tDiv, tPerm) = S
  ParseTbl(tDiv, tComb) = S
  ParseTbl(tDiv, tComa) = R
  ParseTbl(tDiv, tLpr) = S
  ParseTbl(tDiv, tRpr) = R
  ParseTbl(tDiv, tEof) = R
      
  ParseTbl(tPow, tAdd) = R
  ParseTbl(tPow, tSub) = R
  ParseTbl(tPow, tMul) = R
  ParseTbl(tPow, tDiv) = R
  ParseTbl(tPow, tPow) = S
  ParseTbl(tPow, tUmi) = S
  ParseTbl(tPow, tFact) = S
  ParseTbl(tPow, tPerm) = S
  ParseTbl(tPow, tComb) = S
  ParseTbl(tPow, tComa) = R
  ParseTbl(tPow, tLpr) = S
  ParseTbl(tPow, tRpr) = R
  ParseTbl(tPow, tEof) = R

  ParseTbl(tUmi, tAdd) = R
  ParseTbl(tUmi, tSub) = R
  ParseTbl(tUmi, tMul) = R
  ParseTbl(tUmi, tDiv) = R
  ParseTbl(tUmi, tPow) = R
  ParseTbl(tUmi, tUmi) = S
  ParseTbl(tUmi, tFact) = S
  ParseTbl(tUmi, tPerm) = S
  ParseTbl(tUmi, tComb) = S
  ParseTbl(tUmi, tComa) = R
  ParseTbl(tUmi, tLpr) = S
  ParseTbl(tUmi, tRpr) = R
  ParseTbl(tUmi, tEof) = R
      
  ParseTbl(tFact, tAdd) = E4
  ParseTbl(tFact, tSub) = E4
  ParseTbl(tFact, tMul) = E4
  ParseTbl(tFact, tDiv) = E4
  ParseTbl(tFact, tPow) = E4
  ParseTbl(tFact, tUmi) = E4
  ParseTbl(tFact, tFact) = E4
  ParseTbl(tFact, tPerm) = E4
  ParseTbl(tFact, tComb) = E4
  ParseTbl(tFact, tComa) = E4
  ParseTbl(tFact, tLpr) = S
  ParseTbl(tFact, tRpr) = R
  ParseTbl(tFact, tEof) = R
      
  ParseTbl(tPerm, tAdd) = E4
  ParseTbl(tPerm, tSub) = E4
  ParseTbl(tPerm, tMul) = E4
  ParseTbl(tPerm, tDiv) = E4
  ParseTbl(tPerm, tPow) = E4
  ParseTbl(tPerm, tUmi) = E4
  ParseTbl(tPerm, tFact) = E4
  ParseTbl(tPerm, tPerm) = E4
  ParseTbl(tPerm, tComb) = E4
  ParseTbl(tPerm, tComa) = E4
  ParseTbl(tPerm, tLpr) = S
  ParseTbl(tPerm, tRpr) = R
  ParseTbl(tPerm, tEof) = R
      
  ParseTbl(tComb, tAdd) = E4
  ParseTbl(tComb, tSub) = E4
  ParseTbl(tComb, tMul) = E4
  ParseTbl(tComb, tDiv) = E4
  ParseTbl(tComb, tPow) = E4
  ParseTbl(tComb, tUmi) = E4
  ParseTbl(tComb, tFact) = E4
  ParseTbl(tComb, tPerm) = E4
  ParseTbl(tComb, tComb) = E4
  ParseTbl(tComb, tComa) = E4
  ParseTbl(tComb, tLpr) = S
  ParseTbl(tComb, tRpr) = R
  ParseTbl(tComb, tEof) = R
      
  ParseTbl(tComa, tAdd) = R
  ParseTbl(tComa, tSub) = R
  ParseTbl(tComa, tMul) = R
  ParseTbl(tComa, tDiv) = R
  ParseTbl(tComa, tPow) = R
  ParseTbl(tComa, tUmi) = R
  ParseTbl(tComa, tFact) = R
  ParseTbl(tComa, tPerm) = R
  ParseTbl(tComa, tComb) = R
  ParseTbl(tComa, tComa) = E4
  ParseTbl(tComa, tLpr) = R
  ParseTbl(tComa, tRpr) = R
  ParseTbl(tComa, tEof) = E4
      
  ParseTbl(tLpr, tAdd) = S
  ParseTbl(tLpr, tSub) = S
  ParseTbl(tLpr, tMul) = S
  ParseTbl(tLpr, tDiv) = S
  ParseTbl(tLpr, tPow) = S
  ParseTbl(tLpr, tUmi) = S
  ParseTbl(tLpr, tFact) = S
  ParseTbl(tLpr, tPerm) = S
  ParseTbl(tLpr, tComb) = S
  ParseTbl(tLpr, tComa) = S
  ParseTbl(tLpr, tLpr) = S
  ParseTbl(tLpr, tRpr) = S
  ParseTbl(tLpr, tEof) = E1
      
  ParseTbl(tRpr, tAdd) = R
  ParseTbl(tRpr, tSub) = R
  ParseTbl(tRpr, tMul) = R
  ParseTbl(tRpr, tDiv) = R
  ParseTbl(tRpr, tPow) = R
  ParseTbl(tRpr, tUmi) = R
  ParseTbl(tRpr, tFact) = E3
  ParseTbl(tRpr, tPerm) = E3
  ParseTbl(tRpr, tComb) = E3
  ParseTbl(tRpr, tComa) = E4
  ParseTbl(tRpr, tLpr) = E2
  ParseTbl(tRpr, tRpr) = R
  ParseTbl(tRpr, tEof) = R

  ParseTbl(tEof, tAdd) = S
  ParseTbl(tEof, tSub) = S
  ParseTbl(tEof, tMul) = S
  ParseTbl(tEof, tDiv) = S
  ParseTbl(tEof, tPow) = S
  ParseTbl(tEof, tUmi) = S
  ParseTbl(tEof, tFact) = S
  ParseTbl(tEof, tPerm) = S
  ParseTbl(tEof, tComb) = S
  ParseTbl(tEof, tComa) = E4
  ParseTbl(tEof, tLpr) = S
  ParseTbl(tEof, tRpr) = E3
  ParseTbl(tEof, tEof) = A
    
End Sub
 
' Some quick testing.

Init
Test "f ( 3 )"     ' Factorial
Test "p ( 4 , 4 )" ' Permutations
Test "2 + ( 7 * 4 + ( 6 * 4 ) - 1 ) / 2" ' Regular Arithmatic
Test "( 2 ^ 32 )"

Stormy · Post by **Stormy** » Sep 09, 2006 18:02

Didn't test it yet, but it looks great ! :) It's definately worth to try this piece of work. After few (maybe successful) testings, I'll take this into my RPG.

srvaldez · Post by **srvaldez** » Sep 10, 2006 2:31

the ^ operator does not work.

yetifoot · Post by **yetifoot** » Sep 10, 2006 3:10

Thanks, I don't know how i missed that lol, it's fixed now. That was actually broken in the original VB code, i'm suprised no-one noticed that.

duke4e · Post by **duke4e** » Sep 10, 2006 12:13

Wow, it seems like someone readed my mind! 2 days ago I was just thinkin how cool whould it be to have some kind of "on the fly calculator".

Thanks for great code!

srvaldez · Post by **srvaldez** » Sep 11, 2006 1:10

had some problems getting unary minus to work, it works if you put a space before the minus ie " - 123" however the code that checks for unary minus does not get executed.

yetifoot · Post by **yetifoot** » Sep 11, 2006 2:53

I see what you mean, its a bit temperamental.

Code: Select all

Test "( - 5 + 5 ) + 20"

works OK

but

Code: Select all

Test "- ( 5 + 5 ) + 20"

doesn't, unless you add a leading space.

This really was just a quick port from someone elses code, because i wanted to get to understand the method they use, and just make it available.

I don't plan to add features on this one myself, I have a different one in the works that I want to concentrate on.

If you don't want to modify this one yourself, then other people on the forum have also made similar projects that you could try, a search for things like 'evaluation' 'expression' 'parser' etc should find them.