Practice (VB)

Option Explicit

' actions
Private 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
Private 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 Tok As tokEnum          ' token
Dim Tokval As Double        ' token value

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

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

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

Private 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
            MsgBox ("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

Private 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

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

Private 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

Private Sub Parse(Expr As String)

    ' initialize for next expression
    OprTop = 0
    VTop = -1
    Opr(OprTop) = tEof
    TermIndex = -1
    
    Term = Split(Expr)
    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
                    MsgBox "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

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

Public 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