Find the higher precedence operator in the expression. Break the expression into the operator's operands (for example, in 1 + 3 the operator is + and the operands are 1 and 3). Recursively call the EvaluateExpression function to evaluate the operands and combine the results using the correct Visual Basic operator.
A couple details require some thought. First, keep track of the number of open parentheses. If an operator is inside open parentheses, it does not have the highest precedence.
Second, the code needs to watch for unary operators as in +12 and 13 + -6. Where the function encounters a + or - determines whether it is unary. For example, in 13 + -6 the - is unary but the + is not. Read the code to see how the function handles this.
Note how the program handles the code-defined function Factorial. You can add other functions similarly.
|
' Evaluate the expression.
Private Function EvaluateExpression(ByVal expression As _
String) As Double
Const PREC_NONE = 11
Const PREC_UNARY = 10 ' Not actually used.
Const PREC_POWER = 9
Const PREC_TIMES = 8
Const PREC_DIV = 7
Const PREC_INT_DIV = 6
Const PREC_MOD = 5
Const PREC_PLUS = 4
Dim expr As String
Dim is_unary As Boolean
Dim next_unary As Boolean
Dim parens As Integer
Dim pos As Integer
Dim expr_len As Integer
Dim ch As String
Dim lexpr As String
Dim rexpr As String
Dim value As String
Dim status As Long
Dim best_pos As Integer
Dim best_prec As Integer
' Remove all spaces.
expr = Replace$(expression, " ", "")
expr_len = Len(expr)
If expr_len = 0 Then
EvaluateExpression = 0
Exit Function
End If
' If we find + or - now, it is a unary operator.
is_unary = True
' So far we have nothing.
best_prec = PREC_NONE
' Find the operator with the lowest precedence.
' Look for places where there are no open
' parentheses.
For pos = 1 To expr_len
' Examine the next character.
ch = Mid$(expr, pos, 1)
' Assume we will not find an operator. In
' that case, the next operator will not
' be unary.
next_unary = False
If ch = " " Then
' Just skip spaces. We keep them here
' to make the error messages easier to
ElseIf ch = "(" Then
' Increase the open parentheses count.
parens = parens + 1
' A + or - after "(" is unary.
next_unary = True
ElseIf ch = ")" Then
' Decrease the open parentheses count.
parens = parens - 1
' An operator after ")" is not unary.
next_unary = False
' If parens < 0, too many ')'s.
If parens < 0 Then
Err.Raise vbObjectError + 1001, _
"EvaluateExpression", _
"Too many )s in '" & _
expression & "'"
End If
ElseIf parens = 0 Then
' See if this is an operator.
If ch = "^" Or ch = "*" Or _
ch = "/" Or ch = "\" Or _
ch = "%" Or ch = "+" Or _
ch = "-" _
Then
' An operator after an operator
' is unary.
next_unary = True
' See if this operator has higher
' precedence than the current one.
Select Case ch
Case "^"
If best_prec >= PREC_POWER Then
best_prec = PREC_POWER
best_pos = pos
End If
Case "*", "/"
If best_prec >= PREC_TIMES Then
best_prec = PREC_TIMES
best_pos = pos
End If
Case "\"
If best_prec >= PREC_INT_DIV Then
best_prec = PREC_INT_DIV
best_pos = pos
End If
Case "%"
If best_prec >= PREC_MOD Then
best_prec = PREC_MOD
best_pos = pos
End If
Case "+", "-"
' Ignore unary operators
' for now.
If (Not is_unary) And _
best_prec >= PREC_PLUS _
Then
best_prec = PREC_PLUS
best_pos = pos
End If
End Select
End If
End If
is_unary = next_unary
Next pos
' If the parentheses count is not zero,
' there's a ')' missing.
If parens <> 0 Then
Err.Raise vbObjectError + 1002, _
"EvaluateExpression", "Missing ) in '" & _
expression & "'"
End If
' Hopefully we have the operator.
If best_prec < PREC_NONE Then
lexpr = Left$(expr, best_pos - 1)
rexpr = Mid$(expr, best_pos + 1)
Select Case Mid$(expr, best_pos, 1)
Case "^"
EvaluateExpression = _
EvaluateExpression(lexpr) ^ _
EvaluateExpression(rexpr)
Case "*"
EvaluateExpression = _
EvaluateExpression(lexpr) * _
EvaluateExpression(rexpr)
Case "/"
EvaluateExpression = _
EvaluateExpression(lexpr) / _
EvaluateExpression(rexpr)
Case "\"
EvaluateExpression = _
EvaluateExpression(lexpr) \ _
EvaluateExpression(rexpr)
Case "%"
EvaluateExpression = _
EvaluateExpression(lexpr) Mod _
EvaluateExpression(rexpr)
Case "+"
EvaluateExpression = _
EvaluateExpression(lexpr) + _
EvaluateExpression(rexpr)
Case "-"
EvaluateExpression = _
EvaluateExpression(lexpr) - _
EvaluateExpression(rexpr)
End Select
Exit Function
End If
' If we do not yet have an operator, there
' are several possibilities:
'
' 1. expr is (expr2) for some expr2.
' 2. expr is -expr2 or +expr2 for some expr2.
' 3. expr is Fun(expr2) for a function Fun.
' 4. expr is a primitive.
' 5. It's a literal like "3.14159".
' Look for (expr2).
If Left$(expr, 1) = "(" And Right$(expr, 1) = ")" Then
' Remove the parentheses.
EvaluateExpression = EvaluateExpression( _
Mid$(expr, 2, expr_len - 2))
Exit Function
End If
' Look for -expr2.
If Left$(expr, 1) = "-" Then
EvaluateExpression = -EvaluateExpression( _
Mid$(expr, 2))
Exit Function
End If
' Look for +expr2.
If Left$(expr, 1) = "+" Then
EvaluateExpression = EvaluateExpression( _
Mid$(expr, 2))
Exit Function
End If
' Look for Fun(expr2).
If expr_len > 5 And Right$(expr, 1) = ")" Then
' Find the first (.
pos = InStr(expr, "(")
If pos > 0 Then
' See what the function is.
lexpr = LCase$(Left$(expr, pos - 1))
rexpr = Mid$(expr, pos + 1, expr_len - pos - 1)
Select Case lexpr
Case "sin"
EvaluateExpression = _
Sin(EvaluateExpression(rexpr))
Exit Function
Case "cos"
EvaluateExpression = _
Cos(EvaluateExpression(rexpr))
Exit Function
Case "tan"
EvaluateExpression = _
Tan(EvaluateExpression(rexpr))
Exit Function
Case "sqr"
EvaluateExpression = _
Sqr(EvaluateExpression(rexpr))
Exit Function
Case "factorial"
EvaluateExpression = _
Factorial(EvaluateExpression(rexpr))
Exit Function
' Add other functions (including
' program-defined functions) here.
End Select
End If
End If
' See if it's a primitive.
On Error Resume Next
value = m_Primatives.Item(expr)
status = Err.Number
On Error GoTo 0
If status = 0 Then
' We found the primative.
EvaluateExpression = CDbl(value)
Exit Function
End If
' It must be a literal like "2.71828".
On Error Resume Next
EvaluateExpression = CDbl(expr)
status = Err.Number
On Error GoTo 0
If status <> 0 Then
Err.Raise status, _
"EvaluateExpression", _
"Error evaluating '" & expression & _
"' as a constant."
End If
End Function
' Return the factorial of the expression.
Private Function Factorial(ByVal value As Double) As Double
Dim result As Double
' Make sure the value is an integer.
If CLng(value) <> value Then
Err.Raise vbObjectError + 1001, _
"Factorial", _
"Argument must be an integer in Factorial(" & _
Format$(value) & ")"
End If
result = 1
Do While value > 1
result = result * value
value = value - 1
Loop
Factorial = result
End Function
|