User defined functions

[newbee]

Hello to all!

I am new in the world of Pure Basic - I am using the trial version.
I am familiar with QBasic and Liberty Basic.
What I want is to create a program to solve mathematical equations.
The user will pass the equation as a string (I supose) - i.e.: "3*cos(x)".

What shall I do to get the string and "read" it as a mathematical expression?
In Liberty Basic there is the EVAL function, which evaluates a user entered string as a mathematical equation and returns the results.

What can I do in Pure Basic?
Please, give me a hint!

Newbee

[srod]

There is no Eval() type function. I guess that it is easier for Liberty Basic, being an interpreted Basic, to offer that kind of thing.

However, several people have released, through these forums, code to do this kind of thing.

[Kale]

Here's one that was written a long time ago and will probably only run on 32bit cpu's.

http://www.purebasic.fr/english/viewtop ... =12&t=8059

[jack]

here's very simple implementation of eval, with no error checking

Code: Select all

;Expression Evaluator
;written by Jay Reeve
;July 2001
;Release 7 compliance update by STAZ { 8/9/02 }

Procedure.s evaluate(theStr.s)
    Define.s v1, v2, v3, result
    Define.l Lparen, Rparen, parenCount, r, r1, n
    Define.d x, fact
    ;-----------------------------------------------------------------
    theStr = LCase(theStr)
    If Len(theStr)
        If FindString(theStr, "(" ,1)
            Lparen = FindString(theStr, "(" ,1)
            
            v2 = Mid(theStr, Lparen+1)
            
            parenCount = 1
            
            For r = 0 To Len(v2)-1
                If Mid(v2,r,1) = "("
                  parenCount +1
                EndIf
                If Mid(v2,r,1) = ")"
                  parenCount -1
                EndIf
                If parenCount = 0
                  Break
                EndIf
            Next

            ; r   now "string indexes" the right paren 
            ; r+1 is therefore aimed at the right paren in string
            
            v3 = Mid (v2, r+1)          ; tail without right parenthesis
            v2 = Left(v2, r-1)          ; body without either parenthesis
            v1 = Left(theStr, Lparen-1) ; head without left parenthesis

            result = evaluate(v1 + evaluate(v2) + v3)
            
            ;---------------------------------------------------------
        ElseIf FindString(theStr,"+",1)
            r  = FindString(theStr,"+",1)
            v1 = evaluate(Left(theStr,r-1))
            v2 = evaluate(Mid (theStr,r+1))
            result = StrD(ValD(v1) + ValD(v2))
            
        ElseIf FindString(theStr,"-",1)
            r  = FindString(theStr,"-",1)
            v1 = evaluate(Left(theStr,r-1))
            v2 = evaluate(Mid (theStr,r+1))
            result = StrD(ValD(v1) - ValD(v2))
            
        ElseIf FindString(theStr,"*",1)
            r  = FindString(theStr,"*",1)
            v1 = evaluate(Left(theStr,r-1))
            v2 = evaluate(Mid (theStr,r+1))
            result = StrD(ValD(v1) * ValD(v2))

        ElseIf FindString(theStr,"/",1)
            r  = FindString(theStr,"/",1)
            v1 = evaluate(Left(theStr,r-1))
            v2 = evaluate(Mid (theStr,r+1))
            result = StrD(ValD(v1) / ValD(v2))
            
        ElseIf FindString(theStr,"^",1)
            r  = FindString(theStr,"^",1)
            v1 = evaluate(Left(theStr,r-1))
            v2 = evaluate(Mid (theStr,r+1))
            result = StrD(Pow(ValD(v1) , ValD(v2)))
            
        ElseIf FindString(theStr,"!",1)
            r  = FindString(theStr,"!",1)
            v1 = evaluate(Left(theStr,r-1))
            n = ValD(v1)
            fact = 1
            For r = 1 To n
               fact * r
            Next
            result = StrD(fact)
            
        ElseIf FindString(theStr,"sqrt",1)
            r  = FindString(theStr,"sqrt",1)
            v1 = evaluate(Mid (theStr,r+4))
            result = StrD(Sqr(ValD(v1)))

        ElseIf FindString(theStr,"sqr",1)
            r  = FindString(theStr,"sqr",1)
            v1 = evaluate(Mid (theStr,r+3))
            result = StrD(ValD(v1)*ValD(v1))

        ElseIf FindString(theStr,"asin",1)
            r  = FindString(theStr,"asin",1)
            v1 = evaluate(Mid (theStr,r+4))
            result = StrD(ASin(ValD(v1)))

        ElseIf FindString(theStr,"acos",1)
            r  = FindString(theStr,"acos",1)
            v1 = evaluate(Mid (theStr,r+4))
            result = StrD(ACos(ValD(v1)))

        ElseIf FindString(theStr,"atan",1)
            r  = FindString(theStr,"atan",1)
            v1 = evaluate(Mid (theStr,r+4))
            result = StrD(ATan(ValD(v1)))

        ElseIf FindString(theStr,"sin",1)
            r  = FindString(theStr,"sin",1)
            v1 = evaluate(Mid (theStr,r+3))
            result = StrD(Sin(ValD(v1)))

        ElseIf FindString(theStr,"cos",1)
            r  = FindString(theStr,"cos",1)
            v1 = evaluate(Mid (theStr,r+3))
            result = StrD(Cos(ValD(v1)))

        ElseIf FindString(theStr,"tan",1)
            r  = FindString(theStr,"tan",1)
            v1 = evaluate(Mid (theStr,r+3))
            result = StrD(Tan(ValD(v1)))

        ElseIf FindString(theStr,"alog",1)
            r  = FindString(theStr,"alog",1)
            v1 = evaluate(Mid (theStr,r+4))
            result = StrD(Pow(10,ValD(v1)))

        ElseIf FindString(theStr,"log",1)
            r  = FindString(theStr,"log",1)
            v1 = evaluate(Mid (theStr,r+3))
            result = StrD(Log(ValD(v1))*0.4342944819032518)

        ElseIf FindString(theStr,"ln",1)
            r  = FindString(theStr,"ln",1)
            v1 = evaluate(Mid (theStr,r+2))
            result = StrD(Log(ValD(v1)))

        ElseIf FindString(theStr,"exp",1)
            r  = FindString(theStr,"exp",1)
            v1 = evaluate(Mid (theStr,r+3))
            result = StrD(Pow(2.718281828459045,ValD(v1)))
            
        Else
            result = theStr
        EndIf
    Else
        result=""
    EndIf
    ProcedureReturn result
EndProcedure

OpenConsole()
expr.s = " "
PrintN( "press RETURN by itself to end")
While Len(expr)
    Print("enter math expression ")
    expr=Input()
    PrintN(evaluate( expr ))
Wend
CloseConsole()

[srod]

Interesting Jack.

Your code doesn't deal very well with operators of equal precedence however. Try entering 6 - 4 - 2 which of course should have a zero result. Your code gives the incorrect result of 4 because it effectively evaluates 6 - (4 - 2) which is the same as 6 - 4 + 2.

[jack]

you are right, unfortunately it's not my (original) code and have no idea how to fix it.

[srod]

Not easy to fix that because of the way it sets about breaking the expression down into smaller 'parts'. As neat as it is, it does have a lot of problems. E.g. try 2*(3-6).

[Polly]

You must transform the infix notation of the equation into postfix (or Reverse Polish Notation), then you can evalutate it easyly. If search for these terms you will find some hints.

[Trond]

Here is a code that doesn't support functions and only single digits for input:

Code: Select all

Procedure.s ApplyPrecedence(Expr.s)
  PrecedenceMaxL.s = "(((("
  PrecedenceMaxR.s = "))))"
  Expr = ReplaceString(Expr, "(", PrecedenceMaxL)
  Expr = ReplaceString(Expr, ")", PrecedenceMaxR)
  Expr = ReplaceString(Expr, "+", "))+((")
  Expr = ReplaceString(Expr, "-", "))-((")
  Expr = ReplaceString(Expr, "*", ")*(")
  Expr = ReplaceString(Expr, "/", ")/(")
  ProcedureReturn PrecedenceMaxL + Expr + PrecedenceMaxR
EndProcedure

Global Look.c
Global Expr.s

Procedure GetChar()
  Look = Asc(Left(Expr, 1))
  Expr = Mid(Expr, 2)
EndProcedure

Declare.d RecEval()
Procedure.d Value()
  C.c = Look
  Select C
    Case '('
      GetChar()
      A.d = RecEval()
      If Look <> ')'
        CallDebugger ; error
      EndIf
      GetChar()
      ProcedureReturn A
    Case '0' To '9'
      GetChar()
      ProcedureReturn C - '0'
  EndSelect
EndProcedure

Procedure.d RecEval()
  A.d = Value()
  Op.c = Look
  Select Op
    Case '+', '-', '*', '/'
      GetChar()
      B.d = Value()
  EndSelect
  Select Op
    Case '+'
      ProcedureReturn A+B
    Case '-'
      ProcedureReturn A-B
    Case '*'
      ProcedureReturn A*B
    Case '/'
      ProcedureReturn A/B
  EndSelect
  ProcedureReturn A
EndProcedure

Procedure.d Eval(E.s)
  Expr = ApplyPrecedence(E)
  GetChar()
  ProcedureReturn RecEval()
EndProcedure

Debug Eval("1+2*3")

[Trond]

Fully featured: http://www.purebasic.fr/english/viewtop ... expression

[newbee]

I thank you all for your comments!

Srod, exactly, Liberty Basic is an interpreted Basic and so can handle "data" without prior compiling.

Kale, Jack, Trond thank you for all the codes! The codes that you offer are "parsers" (or am I wrong?). I want to create a program for graphical representation of 3D equations
( z= f(x, y) ). That' s mean thousands of calculations of the same equation (function) per run, and so thousands of calls of the parser. So the program will be to slow.

I wonder if I can bypass the fact that the equation will not be part of the original code, and if I can incorporate it in the code while the program is running.
Maybe with a macro order? Or, by calling another not precompiled part of the program or with a script of a "satelite" program?

Thank you in advance!
Newbee

[Demivec]

Kale, Jack, Trond thank you for all the codes! The codes that you offer are "parsers" (or am I wrong?). I want to create a program for graphical representation of 3D equations
( z= f(x, y) ). That' s mean thousands of calculations of the same equation (function) per run, and so thousands of calls of the parser. So the program will be to slow.

I wonder if I can bypass the fact that the equation will not be part of the original code, and if I can incorporate it in the code while the program is running.
Maybe with a macro order? Or, by calling another not precompiled part of the program or with a script of a "satelite" program?

Since you will be parsing the equations anyway what you would do is split the parsing and the executing into separate functions. You would pre-parse (compile) the functions then you would execute them thousands of times You could add an alternative function that would parse and then execute the functions in one shot as well, this would function similar to an interpreter (if only one formula was being executed at a time). Scripting actually can take either form either interpreting and executing a statement at a time, or precompiling for either immediate or later execution.

For your purposes I would recommend precompiling the equations once and then executing them without re-parsing them. This could be done in such a way as to allow the equations to operate on changing values that result from equations that were previously executed in a loop. You could also make the loop a part of the code that is compiled for execution.

[Trond]

Kale, Jack, Trond thank you for all the codes! The codes that you offer are "parsers" (or am I wrong?). I want to create a program for graphical representation of 3D equations

The codes are perfect for this. Run them again and again in a loop with different input values to get your output values.