Example to Evaluate Basic Numeric Expressions

[D.J.Peters]

From the old microsoft knowledge base
english: http://support.microsoft.com/kb/86688/en-us
german: http://support.microsoft.com/kb/86688/de

But can be usefull for your first steps in expression parsing
or as starting point for your own function plotter, game script engine, script language or what ever.

Joshy

Code: Select all

#ifdef __FB_WIN32__
#include "windows.bi"
#define MsgBox(msg) MessageBox(NULL, msg,"error:",0)
#else
#define MsgBox(msg) Print "error: " & msg
#endif

Dim shared e_input    As String  ' Expression input string.
Dim shared e_tok      As String  ' Current token kind.
Dim shared e_spelling As String  ' Current token spelling.
Dim shared e_error    As Integer ' Tells if syntax error occurred.

' e_function.
'   Evaluate a function. This is a helper function to simplify
'   e_prs.
Function e_function(fun As String, arg As Double) As Double
  Dim n As Double

  Select Case LCase$(fun)
    Case "abs": n = Abs(arg)
    Case "atn": n = Atn(arg)
    Case "cos": n = Cos(arg)
    Case "exp": n = Exp(arg)
    Case "fix": n = Fix(arg)
    Case "int": n = Int(arg)
    Case "log": n = Log(arg)
    Case "rnd": n = Rnd(arg)
    Case "sgn": n = Sgn(arg)
    Case "sin": n = Sin(arg)
    Case "sqr": n = Sqr(arg)
    Case "tan": n = Tan(arg)
    Case Else
      If Not e_error Then
         MsgBox("undefined function '" + fun + "'")
         e_error = -1
      End If
   End Select
   e_function = n
End Function

' e_nxt
' Get the next token into e_tok and e_spelling and remove the
' token from e_input.
' This function groups the input into "words" like numbers,
' operators and function names.
Sub e_nxt()
  Dim is_keyword As Integer
  Dim c As String  ' Current input character.

  e_tok = ""
  e_spelling = ""

  ' Skip whitespace.
  Do
    c = Left$(e_input, 1)
    e_input = Mid$(e_input, 2)
  Loop While c = " " Or c = Chr$(9) Or c = Chr$(13) Or c = Chr$(10)

  Select Case LCase$(c)
    ' Number constant. Modify this to support hexadecimal, etc.
    Case "0" To "9", "."
      e_tok = "num"
      Do
        e_spelling = e_spelling + c
        c = Left$(e_input, 1)
        e_input = Mid$(e_input, 2)
      Loop While (c >= "0" And c <= "9") Or c = "."
      e_input = c + e_input

    ' Identifier or keyword.
    Case "a" To "z", "_"
      dim as integer is_id
      e_tok = "id"
      Do
        e_spelling = e_spelling + c
        c = LCase$(Left$(e_input, 1))
        e_input = Mid$(e_input, 2)
        is_id = (c >= "a" And c <= "z")
        is_id = is_id Or c = "_" Or (c >= "0" And c <= "9")
      Loop While is_id
      e_input = c + e_input

      ' Check for keyword.
      is_keyword = -1
      Select Case LCase$(e_spelling)
        Case "and"
        Case "eqv"
        Case "imp"
        Case "mod"
        Case "not"
        Case "or"
        Case "xor"
        Case Else: is_keyword = 0
      End Select
      If is_keyword Then
         e_tok = LCase$(e_spelling)
      End If

    ' Check for <=, >=, <>.
    Case "<", ">"
      e_tok = c
      c = Left$(e_input, 1)
      If c = "=" Or c = ">" Then
         e_tok = e_tok + c
         e_input = Mid$(e_input, 2)
      End If

    ' Single character token.
    Case Else
      e_tok = c
  End Select

  If e_spelling = "" Then
    e_spelling = e_tok
  End If
End Sub
' e_match
' Check the current token and skip past it.
' This function helps with syntax checking.
Sub e_match (token As String)
  If Not e_error And e_tok <> token Then
    MsgBox("expected " + token + ", got '" + e_spelling + "'")
    e_error = -1
  End If
  e_nxt
End Sub

' e_prs
'   Parse an expression, allowing operators of a specified
'   precedence or higher. The lowest precedence is 1.
'   This function gets tokens with e_nxt and recursively
'   applies operator precedence rules.
Function e_prs (p As Integer) As Double
   Dim n   As Double  ' Return value.
   Dim fun As String  ' Function name.
   ' Parse expression that begins with a token (precedence 12).
   If e_tok = "num" Then
      ' number.
      n = Val(e_spelling)
      e_nxt
   ElseIf e_tok = "-" Then
      ' unary minus.
      e_nxt
      n = -e_prs(11)    ' Operand precedence 11.
   ElseIf e_tok = "not" Then
      ' logical NOT.
      e_nxt
      n = Not e_prs(6)  ' Operand precedence 6.
   ElseIf e_tok = "(" Then
      ' parentheses.
      e_nxt
      n = e_prs(1)
      e_match(")")
   ElseIf e_tok = "id" Then
      ' Function call.
      fun = e_spelling
      e_nxt
      e_match("(")
      n = e_prs(1)
      e_match(")")
      n = e_function(fun, n)
   Else
      If Not e_error Then
         MsgBox("syntax error, token = '" + e_spelling + "'")
         e_error = -1
      End If
   End If

   ' Parse binary operators.
  Do While Not e_error
    If     p <= 11 And e_tok = "^"   Then 
      e_nxt: n = n ^ e_prs(12)
    ElseIf p <= 10 And e_tok = "*"   Then 
      e_nxt: n = n *   e_prs(11)
    ElseIf p <= 10 And e_tok = "/"   Then 
      e_nxt: n = n /   e_prs(11)
    ElseIf p <= 9  And e_tok = "\"   Then 
      e_nxt: n = n \   e_prs(10)
    ElseIf p <= 8  And e_tok = "mod" Then 
      e_nxt: n = n Mod e_prs(9)
    ElseIf p <= 7  And e_tok = "+"   Then 
      e_nxt: n = n +   e_prs(8)
    ElseIf p <= 7  And e_tok = "-"   Then 
      e_nxt: n = n -   e_prs(8)
    ElseIf p <= 6  And e_tok = "="   Then 
      e_nxt: n = n =   e_prs(7)
    ElseIf p <= 6  And e_tok = "<"   Then 
      e_nxt: n = n <   e_prs(7)
    ElseIf p <= 6  And e_tok = ">"   Then 
      e_nxt: n = n >   e_prs(7)
    ElseIf p <= 6  And e_tok = "<>"  Then 
      e_nxt: n = n <>  e_prs(7)
    ElseIf p <= 6  And e_tok = "<="  Then 
      e_nxt: n = n <=  e_prs(7)
    ElseIf p <= 6  And e_tok = ">="  Then 
      e_nxt: n = n >=  e_prs(7)
    ElseIf p <= 5  And e_tok = "and" Then 
      e_nxt: n = n And e_prs(6)
    ElseIf p <= 4  And e_tok = "or"  Then 
      e_nxt: n = n Or  e_prs(5)
    ElseIf p <= 3  And e_tok = "xor" Then 
      e_nxt: n = n Xor e_prs(4)
    ElseIf p <= 2  And e_tok = "eqv" Then 
      e_nxt: n = n Eqv e_prs(3)
    ElseIf p <= 1  And e_tok = "imp" Then 
      e_nxt: n = n Imp e_prs(2)
    Else
      Exit Do
    End If
  Loop
  e_prs = n
End Function

' e_eval
'   Evaluate a string containing an infix numeric expression.
'   If successful, return true and place result in <value>.
'   This is the top-level function in the expression evaluator.
Function e_eval(ByVal s As String,byref value As Double) As Integer
   ' Initialize.
   e_error = 0
   e_input = s
   e_nxt

   ' Evaluate.
   value = e_prs(1)

   ' Check for unrecognized input.
   If e_tok <> "" And Not e_error Then
      MsgBox("syntax error, token = '" + e_spelling + "'")
      e_error = -1
   End If

   e_eval = Not e_error
End Function

'
' main
'
dim as string Expression
dim as double Result

Expression = "1+2"
e_eval(Expression,Result)
print Expression & " = " & Result

Expression = "1+2*3"
e_eval(Expression,Result)
print Expression & " = " & Result

Expression = "(1+2)*3"
e_eval(Expression,Result)
print Expression & " = " & Result

Expression = "atn(1)*4"
e_eval(Expression,Result)
print "PI = " & Expression & " = " & Result

Expression = "abs((1+2+3) > (0+1+2)) * 100"
e_eval(Expression,Result)
print Expression & " = " & Result

sleep

[dodicat]

[quote="D.J.Peters"]
Hi D,J.peters
This is a versitile little parser, with only a small modification Ive made up a very simple function plotter, just set on an x range -10 to 10, and a y range updater

Code: Select all

#ifdef __FB_WIN32__
#include "windows.bi"
#define MsgBox(msg) MessageBox(NULL, msg,"error:",0)
#else
#define MsgBox(msg) Print "error: " & msg
#endif

Dim Shared e_input    As String  ' Expression input string.
Dim Shared e_tok      As String  ' Current token kind.
Dim Shared e_spelling As String  ' Current token spelling.
Dim Shared e_error    As Integer ' Tells if syntax error occurred.
dim shared x as double           'substitutes as a number in an expression

' e_function.
'   Evaluate a function. This is a helper function to simplify
'   e_prs.
Function e_function(fun As String, arg As Double) As Double
  Dim n As Double

  Select Case Lcase$(fun)
    Case "abs": n = Abs(arg)
    Case "atn": n = Atn(arg)
    Case "cos": n = Cos(arg)
    Case "exp": n = Exp(arg)
    Case "fix": n = Fix(arg)
    Case "int": n = Int(arg)
    Case "log": n = Log(arg)
    Case "rnd": n = Rnd(arg)
    Case "sgn": n = Sgn(arg)
    Case "sin": n = Sin(arg)
    Case "sqr": n = Sqr(arg)
    Case "tan": n = Tan(arg)
    Case Else
      If Not e_error Then
         MsgBox("undefined function '" + fun + "'")
         e_error = -1
      End If
   End Select
   e_function = n
End Function

' e_nxt
' Get the next token into e_tok and e_spelling and remove the
' token from e_input.
' This function groups the input into "words" like numbers,
' operators and function names.
Sub e_nxt()
  Dim is_keyword As Integer
  Dim c As String  ' Current input character.

  e_tok = ""
  e_spelling = ""

  ' Skip whitespace.
  Do
    c = Left$(e_input, 1)
    e_input = Mid$(e_input, 2)
  Loop While c = " " Or c = Chr$(9) Or c = Chr$(13) Or c = Chr$(10)

  Select Case Lcase$(c)
    ' Number constant. Modify this to support hexadecimal, etc.
  Case "0" To "9", ".","x"
      if c="x" then c=str(x)  'ALTERATION **********************
      e_tok = "num"
      Do
        e_spelling = e_spelling + c
        c = Left$(e_input, 1)
        e_input = Mid$(e_input, 2)
      Loop While (c >= "0" And c <= "9") Or c = "." or c="x" 'ALTERATION *********
      e_input = c + e_input

    ' Identifier or keyword.
    Case "a" To "z", "_"
      Dim As Integer is_id
      e_tok = "id"
      Do
        e_spelling = e_spelling + c
        c = Lcase$(Left$(e_input, 1))
        e_input = Mid$(e_input, 2)
        is_id = (c >= "a" And c <= "z")
        is_id = is_id Or c = "_" Or (c >= "0" And c <= "9")
      Loop While is_id
      e_input = c + e_input

      ' Check for keyword.
      is_keyword = -1
      Select Case Lcase$(e_spelling)
        Case "and"
        Case "eqv"
        Case "imp"
        Case "mod"
        Case "not"
        Case "or"
        Case "xor"
        Case Else: is_keyword = 0
      End Select
      If is_keyword Then
         e_tok = Lcase$(e_spelling)
      End If

    ' Check for <=, >=, <>.
    Case "<", ">"
      e_tok = c
      c = Left$(e_input, 1)
      If c = "=" Or c = ">" Then
         e_tok = e_tok + c
         e_input = Mid$(e_input, 2)
      End If

    ' Single character token.
    Case Else
      e_tok = c
  End Select

  If e_spelling = "" Then
    e_spelling = e_tok
  End If
End Sub
' e_match
' Check the current token and skip past it.
' This function helps with syntax checking.
Sub e_match (token As String)
  If Not e_error And e_tok <> token Then
    MsgBox("expected " + token + ", got '" + e_spelling + "'")
    e_error = -1
  End If
  e_nxt
End Sub

' e_prs
'   Parse an expression, allowing operators of a specified
'   precedence or higher. The lowest precedence is 1.
'   This function gets tokens with e_nxt and recursively
'   applies operator precedence rules.
Function e_prs (p As Integer) As Double
   Dim n   As Double  ' Return value.
   Dim fun As String  ' Function name.
   ' Parse expression that begins with a token (precedence 12).
   If e_tok = "num" Then
      ' number.
      n = Val(e_spelling)
      e_nxt
   Elseif e_tok = "-" Then
      ' unary minus.
      e_nxt
      n = -e_prs(11)    ' Operand precedence 11.
   Elseif e_tok = "not" Then
      ' logical NOT.
      e_nxt
      n = Not e_prs(6)  ' Operand precedence 6.
   Elseif e_tok = "(" Then
      ' parentheses.
      e_nxt
      n = e_prs(1)
      e_match(")")
   Elseif e_tok = "id" Then
      ' Function call.
      fun = e_spelling
      e_nxt
      e_match("(")
      n = e_prs(1)
      e_match(")")
      n = e_function(fun, n)
   Else
      If Not e_error Then
         MsgBox("syntax error, token = '" + e_spelling + "'")
         e_error = -1
      End If
   End If

   ' Parse binary operators.
  Do While Not e_error
    If     p <= 11 And e_tok = "^"   Then 
      e_nxt: n = n ^ e_prs(12)
    Elseif p <= 10 And e_tok = "*"   Then 
      e_nxt: n = n *   e_prs(11)
    Elseif p <= 10 And e_tok = "/"   Then 
      e_nxt: n = n /   e_prs(11)
    Elseif p <= 9  And e_tok = ""   Then 
      e_nxt: n = n \   e_prs(10)
    Elseif p <= 8  And e_tok = "mod" Then 
      e_nxt: n = n Mod e_prs(9)
    Elseif p <= 7  And e_tok = "+"   Then 
      e_nxt: n = n +   e_prs(8)
    Elseif p <= 7  And e_tok = "-"   Then 
      e_nxt: n = n -   e_prs(8)
    Elseif p <= 6  And e_tok = "="   Then 
      e_nxt: n = n =   e_prs(7)
    Elseif p <= 6  And e_tok = "<"   Then 
      e_nxt: n = n <   e_prs(7)
    Elseif p <= 6  And e_tok = ">"   Then 
      e_nxt: n = n >   e_prs(7)
    Elseif p <= 6  And e_tok = "<>"  Then 
      e_nxt: n = n <>  e_prs(7)
    Elseif p <= 6  And e_tok = "<="  Then 
      e_nxt: n = n <=  e_prs(7)
    Elseif p <= 6  And e_tok = ">="  Then 
      e_nxt: n = n >=  e_prs(7)
    Elseif p <= 5  And e_tok = "and" Then 
      e_nxt: n = n And e_prs(6)
    Elseif p <= 4  And e_tok = "or"  Then 
      e_nxt: n = n Or  e_prs(5)
    Elseif p <= 3  And e_tok = "xor" Then 
      e_nxt: n = n Xor e_prs(4)
    Elseif p <= 2  And e_tok = "eqv" Then 
      e_nxt: n = n Eqv e_prs(3)
    Elseif p <= 1  And e_tok = "imp" Then 
      e_nxt: n = n Imp e_prs(2)
    Else
      Exit Do
    End If
  Loop
  e_prs = n
End Function

' e_eval
'   Evaluate a string containing an infix numeric expression.
'   If successful, return true and place result in <value>.
'   This is the top-level function in the expression evaluator.
Function e_eval(Byval s As String,Byref value As Double) As Integer
   ' Initialize.
   'if s="external" then s=external
   e_error = 0
   e_input = s
   e_nxt

   ' Evaluate.
   value = e_prs(1)

   ' Check for unrecognized input.
   If e_tok <> "" And Not e_error Then
      MsgBox("syntax error, token = '" + e_spelling + "'")
      e_error = -1
   End If

   e_eval = Not e_error
End Function

'
' main
'
Dim As String Expression
Dim As Double Result


dim as integer xres,yres
xres=800
yres=600
screenres xres,yres
locate 3,3
print "Enter expression, use x as the variable e.g. sin(1-x), x^3  "
locate 6,3
input "expression  --->  ";expression
dim as double miny=10000,maxy=-10000,xaxis
'get min and max of y for cartesian plot
for x=-10 to 10 step .01
    e_eval(expression,result)
    if miny>result then miny=result
    if maxy<result then maxy=result
    if abs(result)<1e-4 then xaxis=result
next
xaxis=yres*(xaxis-maxy)/(miny-maxy)
'draw approx axis
line(0,xaxis)-(xres,xaxis)
line(xres/2,0)-(xres/2,yres)

dim _x as double
dim _y as double
for x=-10 to 10 step .01
    e_eval(expression,result)
    _x=xres*(x+10)/20
     _y=yres*(result-maxy)/(miny-maxy)
    pset(_x,_y)
    next
Sleep

[Lionheart2020]

hi d.j. peters :)

it's possible to expand (add with functionality) your interesting parser code example with inputs for calculations by users ? would be nice. -> good job! I like this one. much to learn.

nice day, bye, lionheart