PureBasic Forums - English

Posted: **Wed Jun 29, 2005 5:38 pm**

Code updated for 5.20+

This is a recursive descent parser expression evaluator able to fix the math for you. It's based on PureBasic's
built in math of course, with a few differences: == is equal to, & is AND, | is OR.

Code: Select all

;String math expression evaluator,  utopiomania 20070211
;PureBasic 4.00

Declare.f eval(str.s)
Declare.f level1()
Declare.f level2()
Declare.f level3()
Declare.f level4()
Declare.f level5()
Declare.f level6()
Declare.f level7()
Declare.f level8()
Declare.f level9()
Declare.f primitive()
Declare.f calc(op.s, num1.f, num2.f)
Declare.f unary(op.s, num.f)
Declare rewind()
Declare.f letVar(var.s, num.f)
Declare.f getVar()
Declare.f clearVars()
Declare gettoken()
Declare isFunc(str.s)
Declare isCommand(str.s)
Declare isMinus(str.s)
Declare isParenth(str.s)
Declare isDelim(str.s)
Declare notDelim(str.s)
Declare isAlpha(str.s)
Declare isDigit(str.s)
Declare isSpace(str.s)
Declare notVailidop(op.s)
Declare isErr(str.s)

;holds the expression to be evaluated:
Global expr.s
;Points to the next token in expression:
Global progr.l
;holds the token:
Global token.s
;token type:
Global ttype.l

#MAXVARS = 1000
Global Dim varNames.s(#MAXVARS)
Global Dim vars.f(#MAXVARS)

#MAXFNC = 11
Global Dim fnc.s(#MAXFNC)
fnc(0) = "ACOS": fnc(1) = "ASIN": fnc(2) = "ATAN": fnc(3) = "ABS"
fnc(4) = "COS": fnc(5) = "INT": fnc(6) = "LOG": fnc(7) = "LOG10"
fnc(8) = "SIN": fnc(9) = "SQR": fnc(10) = "TAN"

#MAXCMD = 1
Global Dim cmd.s(#MAXCMD)
cmd(0) = "CLEAR"

;token types:
#DELIM = 1
#VARIABLE = 2
#NUMBER = 3
#FUNCTION = 4
#COMMAND = 5

Global error.s
Global ERR_SYNTAX.s, ERR_PARENTH.s, ERR_NOEXPR.s, ERR_DIVZERO.s
ERR_SYNTAX = "SYNTAX ERROR"
ERR_PARENTH = "UNBALANCED PARENTHESES"
ERR_NOEXPR = "NO EXPRESSION"
ERR_DIVZERO = "DIVISION BY ZERO"

Procedure.f eval(str.s)
  ;entry point into parser
  progr = 1
  error = ""
  expr = UCase(str)
  gettoken()
  If token = ""
    error = ERR_NOEXPR
  EndIf
  isErr(expr)
  If Len(error)
    ProcedureReturn #False
  EndIf
  ProcedureReturn level1()
EndProcedure

Procedure.f level1()
  ;assignment statement/command
  typ.l
  tok.s
  If ttype= #VARIABLE
    ;Save old token
    tok = token
    typ = ttype
    gettoken()
    If token = "="
      ;assignment
      gettoken()
      ProcedureReturn letVar(tok, level2())
    Else
      ;Restore
      Rewind()
      token = tok
      ttype = Typ
    EndIf
  ElseIf ttype = #COMMAND
    If token = "CLEAR"
      ;Restore
      rewind()
      token = tok
      ttype = typ
      clearVars()
      ProcedureReturn 0
    EndIf
  EndIf
  ProcedureReturn level2()
EndProcedure

Procedure.f level2()
  ;logical  and/or
  result.f = level3()
  op.s = token
  While (op = "&") Or (op = "|")
    gettoken()
    result = calc(op, result, level3())
    op = token
  Wend
  ProcedureReturn result
EndProcedure

Procedure.f level3()
  ;conditional operators
  result.f = level4()
  op.s = token
  While (op = "<") Or (op = ">") Or (op = "<>") Or (op = "<=") Or (op = ">=") Or (op = "==")
    gettoken()
    result = calc(op, result, level4())
    op = token
  Wend
  ProcedureReturn result
EndProcedure

Procedure.f level4()
  ;add or subtract two terms
  result.f = level5()
  op.s = token
  While (op = "+") Or (op = "-")
    gettoken()
    result = calc(op, result, level5())
    op = token
  Wend
  ProcedureReturn result
EndProcedure

Procedure.f level5()
  ;multiply,  divide
  result.f = level6()
  op.s = token
  While (op = "*") Or (op = "/")
    gettoken()
    result = calc(op, result, level6())
    op = token
  Wend
  ProcedureReturn result
EndProcedure

Procedure.f level6()
  ;Exponent
  result.f = level7()
  If token = "^"
    gettoken()
    result = calc("^", result, level7())
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.f level7()
  ;unary plus or minus
  op.s = ""
  If (ttype = #DELIM) And ((token = "+") Or (token = "-"))
    op = token
    gettoken()
  EndIf
  result.f = level8()
  If Len(op)
    result = Unary(op, result)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.f level8()
  ;functions
  op.s = ""
  If ttype = #FUNCTION
    op = token
    gettoken()
  EndIf
  result.f = level9()
  If Len(op)
    result = calc(op, result, 0)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.f level9()
  ;parenthesized expression
  result.f
  If (ttype = #DELIM) And (token = "(")
    gettoken()
    result = level1()
    gettoken()
  Else
    result = primitive()
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.f primitive()
  ;find value of number or variable
  result.f
  Select ttype
    Case #VARIABLE
      result = getVar()
      gettoken()
    Case #NUMBER
      result = ValF(token)
      gettoken()
    Default
      error = ERR_SYNTAX
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure.f calc(op.s, num1.f, num2.f)
  result.f
  Select op
    Case "&"
      result = Bool(num1 And num2)
    Case "|"
      result = Bool(num1 Or num2)
    Case "<"
      If num1 < num2
        result = 1
      EndIf
    Case ">"
      If num1 > num2
        result = 1
      EndIf
    Case "<>"
      If num1 <> num2
        result = 1
      EndIf
    Case "<="
      If num1 <= num2
        result = 1
      EndIf
    Case ">="
      If num1 >= num2
        result = 1
      EndIf
    Case "=="
      If num1 = num2
        result = 1
      EndIf
    Case "-"
      result = num1 - num2
    Case "+"
      result = num1 + num2
    Case "*"
      result = num1 * num2
    Case "/"
      If num2 <> 0
        result = num1 / num2
      Else
        error = ERR_DIVZERO
        result = 0
      EndIf
    Case "^"
      result = Pow(num1, num2)
    Case "ACOS"
      result = ACos(num1)
    Case "ASIN"
      result = ASin(num1)
    Case "ATAN"
      result = ATan(num1)
    Case "ABS"
      result = Abs(num1)
    Case "COS"
      result = Cos(num1)
    Case "INT"
      result = Int(num1)
    Case "LOG"
      result = Log(num1)
    Case "LOG10"
      result = Log10(num1)
    Case "SIN"
      result = Sin(num1)
    Case "SQR"
      result = Sqr(num1)
    Case "TAN"
      result = Tan(num1)
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure.f unary(op.s, num.f)
  ;unary minus
  If op = "-"
    ProcedureReturn -num
  EndIf
  ProcedureReturn num
EndProcedure

Procedure rewind()
  ;back up to the previous token
  progr = progr - Len(token)
EndProcedure

Procedure.f letVar(var.s, num.f)
  ;assign a value to a variable
  i = 0
  While Len(varNames(i))
    If var = varNames(i)
      vars(i) = num
      ProcedureReturn num
    EndIf
    i + 1
  Wend
  varNames(i) = var
  vars(i) = num
  ProcedureReturn num
EndProcedure

Procedure.f getVar()
  ;find value of a variable
  i = 0
  While Len(varNames(i))
    If token = varNames(i)
      ProcedureReturn vars(i)
    EndIf
    i + 1
  Wend
  letVar(token, 0)
  ProcedureReturn getVar()
EndProcedure

Procedure.f clearVars()
  ;clears variable names and values:
  For i = 0 To #MAXVARS - 1
    vars(i) = 0
    varNames(i) = ""
  Next
EndProcedure

Procedure getToken()
  ;get the next token/token type in expression
  ttype = 0
  token = ""
  If progr > Len(expr)
    ProcedureReturn
  EndIf
  While isSpace(Mid(expr, progr, 1))
    Progr + 1
  Wend
  Select #True
    Case isMinus(Mid(expr, progr, 1))
      ttype = #DELIM
      token = Mid(expr, progr, 1)
      progr + 1
    Case isParenth(Mid(expr, progr, 1))
      ttype = #DELIM
      token = Mid(expr, progr, 1)
      progr + 1
    Case isDelim(Mid(expr, progr, 1))
      ttype = #DELIM
      While isDelim(Mid(expr, progr, 1))
        token + Mid(expr, progr, 1)
        progr + 1
      Wend
      If notVailidop(token)
        error = ERR_SYNTAX
      EndIf
    Case isAlpha(Mid(expr, progr, 1))
      While notDelim(Mid(expr, progr, 1))
        token + Mid(expr, progr, 1)
        progr + 1
      Wend
      If isFunc(token)
        ttype= #FUNCTION
      Else
        If isCommand(token)
          ttype = #COMMAND
        Else
          ttype = #VARIABLE
        EndIf
      EndIf
    Case isDigit(Mid(expr, progr, 1))
      ttype = #NUMBER   
      While NotDelim(Mid(expr, progr, 1))
        token + Mid(expr, progr, 1)
        progr + 1
      Wend
  EndSelect
EndProcedure

Procedure isFunc(str.s)
  For i = 0 To #MAXFNC - 1
    If str = fnc(i)
      ProcedureReturn #True
    EndIf
  Next
  ProcedureReturn #False
EndProcedure

Procedure isCommand(str.s)
  For i = 0 To #MAXCMD - 1
    If str = cmd(i)
      ProcedureReturn #True
    EndIf
  Next
  ProcedureReturn #False
EndProcedure

Procedure isMinus(str.s)
  If FindString("-", str, 1)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure isParenth(str.s)
  If FindString("()", str, 1)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure isDelim(str.s)
  If (FindString("&|<>+/*^=", str, 1) > 0) And (str <> "")
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure NotDelim(str.s)
  If (FindString("&|<>+-/*^=()" + Chr(32) + Chr(9), str, 1) > 0) Or (str = "")
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure isAlpha(str.s)
  If FindString("ABCDEFGHIJKLMNOPQRSTUVWXYZ", str, 1)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure isDigit(str.s)
  If FindString(".0123456789", str, 1)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure isSpace(str.s)
  If ((str = " ") Or (str = Chr(9))) And (str <> "")
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure notVailidop(op.s)
  If Len(op) = 1
    ProcedureReturn #False
  EndIf
  Select token
    Case "<>"
      ProcedureReturn #False
    Case "<= "
      ProcedureReturn #False
    Case ">= "
      ProcedureReturn #False
    Case "== "
      ProcedureReturn #False
    Case "--"
      ProcedureReturn #False
  EndSelect
  ProcedureReturn #True
EndProcedure

Procedure isErr(str.s)
  ;Check for some errors
  str1.s
  str2.s
  err = 0
  str = UCase(str)
  ;Check for unbalanced parentheses
  For i = 1 To Len(str)
    If Mid(str, i, 1) = "("
      err + 1
    EndIf
    If Mid(str, i, 1) = ")"
      err - 1
    EndIf
  Next
  If err
    error = ERR_PARENTH
    ProcedureReturn #True
  EndIf
  ;Check for Illegal characters
  str1 = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  str2 = "0123456789.&|<>+-/%*^=()" + Chr(9)
  For i = 1 To Len(str)
    If FindString(str1 + str2, Mid(str, i, 1), 1) = 0
      err + 1
    EndIf
  Next
  If err
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure


;DEMO
OpenConsole()
ConsoleTitle("Expression evaluator")

eval("a = 10")
eval("b = 25.25")
PrintN(StrF(eval("a * b+b")))

PrintN("[Enter] to end...")
Input()
end

Posted: **Wed Jun 29, 2005 8:12 pm**

OMG! You lost me when you wrote "recursive descent parser expression evaluator"!!!

What on earth does it mean (in stupid people language please)? I'm a complete dummy when it comes to maths (and PB of course) and haven't a clue what your code does. It looks very impressive though fwiw

Jim

Posted: **Wed Jun 29, 2005 8:41 pm**

Sorry, didn't mean to impress with stupid names, but it's what one kind of solution
to this problem is actually named.

To see what it does, type in 2+2, then press Enter, or type in A=sqr(2^3)-.2 and Enter then
MyVar=A*2-.3 and then Enter, or 1<>2. See what it does??

Posted: **Wed Jun 29, 2005 8:48 pm**

utopiomania,
Nice Code, very impressive!

xgo

Posted: **Wed Jun 29, 2005 9:17 pm**

utopiomania wrote:Sorry, didn't mean to impress with stupid names, but it's what one kind of solution to this problem is actually named.
To see what it does, type in 2+2, then press Enter, or type in A=sqr(2^3)-.2 and Enter then MyVar=A*2-.3 and then Enter, or 1<>2. See what it does??

It's not that it's a stupid name so much as I'm just not bright enough to translate into laymans terms exactly what it's supposed to mean hehe! I get it now, I think. How many others will pop out of the woodwork and admit as much I wonder???

I take my hat off to you utopiomania, that really is very impressive coding. I'm dreaming of the day I can write something half as complex

Jim

Posted: **Wed Jun 29, 2005 9:26 pm**

Thanks, xgp, take it away if you find a need for it.

Jimbo_H, you can do this
in a much shorter time than you think.! Using PureBasic that is!

Posted: **Thu Jun 30, 2005 12:25 am**

Applause.

Very impressive.

Posted: **Thu Jun 30, 2005 2:33 am**

Very clean dialect!

Saved and Thank You! from here.

I can never discipline myself this far...

I have to say, "How Pure!"
Rand

Posted: **Thu Jun 30, 2005 3:38 am**

Quite nice. Good stuff.

Posted: **Thu Jun 30, 2005 1:17 pm**

Very nice work

Posted: **Thu Jun 30, 2005 3:29 pm**

How come 456(0) returns 456 and not 0?
And --1 generates a syntax error while -(-1) does not.
And sdkfgh returns 0.0000 while æøå returns no expression.

Posted: **Thu Jun 30, 2005 4:51 pm**

Thanks all, for your comments!

@Trond, N(M) is by design, it needs an operator, --N should probably?
be fixed, as it handles N=-1<Enter> -N<Enter> correctly.

ÆØÅ aren't considered legal characters and as such should generate a syntax error or no expression.

Posted: **Thu Jun 30, 2005 5:08 pm**

But that's good yeah, like all other routines, too.
Uhm maybe someone could implement in his Evalfunction equations with more than one variable(and mixed quadratic equations).

Posted: **Thu Jun 30, 2005 5:31 pm**

utopiomania wrote:Thanks all, for your comments! @Trond, N(M) is by design, it needs an operator, --N should probably?
be fixed, as it handles N=-1<Enter> -N<Enter> correctly.

ÆØÅ aren't considered legal characters and as such should generate a syntax error or no expression.

If it needs an operator an error message would be nice.

Posted: **Thu Jun 30, 2005 6:15 pm**

Trond wrote:

If it needs an operator an error message would be nice.

I agree, the error handling is far from bullet proof.

Daniel, it handles any number of variables up to #MAXVARS, and you can use long variable
names if you like.

PureBasic Forums - English

Expression evaluator

Expression evaluator

That is Pure Basic!