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
