Author Topic: EVAL Function (Read 4319 times)

bplus · « **on:** February 15, 2021, 10:27:23 pm »

For those who just walked in the door to the Shorthand Basic (like and luv'd) Interpreter or SB and SB1, you've got to know about EVAL functions that convert strings of numbers formulas and outputs, if all goes well, a single number that is pretty accurate but let's not expect perfect with floating point maths involved. And if all does not go well helps the user by pointing to their mistake ;) like EVAL doesn't make mistakes.

Here is mine just fixed and retested tonight:

Code: QB64: [Select]

Option _Explicit
_Title "Eval Remake Fix Not 2021-02-15" ' B+ 
' from: EVAL  2018-02-05 5:53 PM
' Goals do it without Wrd$ functions
' Do it for both string and math functions
 
' 2021-02-15  not is broken!!  fixed I think moved to Function list because NO is NOT a Bianary Operation!!!
' 2021-02-15 it looks like subtract and -number can be differentaited so that - for subtraction does Not
'            have to be wrapped in spaces, oh yeah oh yeah!
'              e$ = "2*-3--4+-0.25" ' returns -2.25 OK  -6 + 4 -.25
' completely retested all strings below, fixed not by moving it to the Function list,
' and removing it from the BINARY ops list because NOT is NOT a BINARY FUNCTION THAT REQUIRES TWO ARGUMENTS
 
Const XMAX = 1200
Const YMAX = 720
 
Screen _NewImage(XMAX, YMAX, 32)
_ScreenMove 100, 0
 
Dim Shared debug As _Bit
debug = -1
 
'evaluate$ and evalW setup
Dim Shared DFlag As _Bit, EvalErr$, GlobalX As _Float, RAD As _Float, DEG As _Float
DFlag = -1
EvalErr$ = ""
GlobalX = 5 'changeable
RAD = _Pi / 180.0
DEG = 180 / _Pi
ReDim Shared fList(1 To 1) As String
Split "int, sin, cos, tan, asin, acos, atan, log, exp, sqr, rad, deg, not", ", ", fList() ' add not function here
ReDim Shared oList(1 To 1) As String
Split "^, %, /, *, -, +, =, <, >, <=, >=, <>, or, and", ", ", oList() ' not is NOT a Binary Op
 
'main dim
Dim e$, r$
'  tests
 
e$ = "PI" ' ok caps or not
'e$ = "pi" 'ok
'e$ = "1 +1"
'e$ = "-1+1" 'ok
'e$ = "(5 - 7) * 2" '-4 ok
'e$ = "(5-7)* 2" '-4 ok
'e$ = "(-5--7)*2" '4 ok
'e$ = "2*(-5-7)" ' -24  ok
'e$ = "(-1--2)+(-3--4)" ' 2 ok 1 + 1
'e$ = "x*x-2*x-3" ' x = 5 returns 12
 
' new not tests
'e$ = "not-1" ' wrong! syntax returns -1  but no error thrown
'e$ = "not(-1)" ' fixed
'e$ = "not(-1 or -1)" ' ok fixed
'e$ = "not(0)" 'yeah good
'e$ = "not(-8)"
'e$ = "not (-1)" '  wrong syntax but this works????  because ( and ) can be wrapped in spaces
'e$ = "not (0)" ' wrong syntax  but works???  it's because of way ( ) can be spaced or not
'e$ = "-1 not" ' wrong syntax crash bang boom but the line is soooo wrong , no error
 
'e$ = "-1 or 0" 'OK
'e$ = "log(0)" 'err
'e$ = "log(2)"
'e$ = "exp(.69314718055)" 'inverse above  close enough
'e$ = "exp(-745) " '-745 no err! -746 err!
'e$ = "exp(-693) " ' FB -693 limit 1.0812... E-301 bottom limit no error on my system, -708 on another test
'e$ = "exp( 709) " ' no err , FB 707 limit 8.21840... E+307no error on my system
'e$ = "sqr(-10)" 'err
'e$ = "-5 ^ 1.9" 'err good get err message
'e$ = "2*-3--4+-0.25" ' returns -2.25 OK don't need to isolate - meant for subtraction !!! <<<<<<<<<<<<<<<<<<<<< see fixed 2021-02-15
'e$ = "1+2*(3+((4*5)+(6*7*8))-9)/10" ' returns 71 OK  OK fixed!
'e$ = " 1+2*(3-2*(3-2)*((2-4)*5-22/(7+2*(3-1))-1))+1" ' returns 60 OK
'e$ = "1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2"
'' returns euler's 2.718 281 828 458 994 464 285 469 58 OK for as far as it goes 2.718 281 828 458 995 last digit off by 1  OK!!!
'e$ = "(1.4 + 2^(19%4))/2" ' = 4.7 OK OK
'e$ = "e^2" ' = 7.3890...
'e$ = "PI/6" '= .52...
'e$ = "x ^ (200/400)" ' = 2.23606... when sqr(x) x = 5
'e$ = "x^2-2*x-15" ' = 0 when x = 5 good!
'e$ = "e^ 8" ' > 2980.958
'e$ = " log(2980.958)" ' > 8.000..
'e$ = "sin(x)^2 + cos(x)^2" ' > ~1
'e$ = "atan(1)" 'should be 45 degrees if degrees flag on nope, correct in radians  fixed  2021-02-15
'e$ = "atan(sin(30)/cos(30))" ' > 30 with DFlag = 1   2021-02-15 eeeh no? fixed  2021-02-15
'e$ = ".3 + 2*10^-8" ' .30000002
'e$ = "pi/6 < pi" ' -1 of course yeah my first Boolean!
'e$ = "99 % 11 = 0"
'e$ = "23 <= 22" ' 0?   of course!
'e$ = "(99 % 9 = 0) and (not (  (23 < 22) or (5 < 3)  )) " ' (0) and ( not ((0) or (0) ) )  the first part is -1 so 0! 2nd part -1 so ok!
 
'IMPORTANT NOTE: wrap - sign with spaces if meant for subtraction,   '<<<<<<<<<<<<<<<<< I thought I fixed this??? 2021-02-15
'if meant to signal neg number leave no space between it and number
 
Print e$
r$ = Evaluate$(e$)
If EvalErr$ <> "" Then Print "Error: "; EvalErr$ Else Print "Expression = "; r$
Print "Done"
Sleep
 
'this preps e$ string for actual evaluation function and makes call to it,
'checks results for error returns that or string form of result calculation
'the new goal is to do string functions along side math
Function Evaluate$ (e$)
    Dim b$, c$, subst$, t$
    Dim i As Integer, po As Integer, p As Integer, lb As Integer, ub As Integer ', isolateNeg AS _BIT
    ' isolateNeg = 0
    b$ = "" 'rebuild string with padded spaces
    'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
    For i = 1 To Len(e$) 'filter chars and count ()
        c$ = LCase$(Mid$(e$, i, 1))
        If c$ = ")" Then
            po = po - 1: b$ = b$ + " ) "
        ElseIf c$ = "(" Then
            po = po + 1: b$ = b$ + " ( "
        ElseIf InStr("+*/%^", c$) > 0 Then
            b$ = b$ + " " + c$ + " "
        ElseIf c$ = "-" Then
            If Len(b$) > 0 Then
                If InStr(".0123456789abcdefghijklmnopqrstuvwxyz)", Right$(RTrim$(b$), 1)) > 0 Then
                    b$ = b$ + " " + c$ + " "
                Else
                    b$ = b$ + " " + c$
                End If
            Else
                b$ = b$ + " " + c$
            End If
        ElseIf InStr(" .0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 Then
            b$ = b$ + c$
        End If
        If po < 0 Then EvalErr$ = "Too many )": Exit Function
    Next
    If po <> 0 Then EvalErr$ = "Unbalanced ()": Exit Function
    ReDim ev(1 To 1) As String
    Split b$, " ", ev()
    For i = LBound(ev) To UBound(ev) 'subst constants
        If ev(i) = "pi" Then
            ev(i) = LTrim$(Str$(_Pi))
        ElseIf ev(i) = "x" Then
            ev(i) = LTrim$(Str$(GlobalX))
        ElseIf ev(i) = "e" Then
            ev(i) = LTrim$(Str$(Exp(1)))
        End If
    Next
    c$ = evalW$(ev())
    If EvalErr$ <> "" Then Evaluate$ = EvalErr$ Else Evaluate$ = c$
 
End Function
 
' the recursive part of EVAL
Function evalW$ (a() As String)
    If EvalErr$ <> "" Then Exit Function
 
    Dim fun$, test$, w$, innerV$, m$, op$
    Dim pop As Integer, lPlace As Integer, i As Integer, rPlace As Integer, wc As Integer
    Dim po As Integer, p As Integer, o As Integer, index As Integer, saveR As Integer
    Dim recurs As Integer
    Dim innerVal As _Float, a As _Float, b As _Float
    If debug Then
        Print "evalW rec'd a() as:"
        For i = LBound(a) To UBound(a)
            Print a(i); ", ";
        Next
        Print: Input "OK enter"; test$: Print
    End If
    pop = find%(a(), "(") 'parenthesis open place
    While pop > 0
        If pop = 1 Then
            fun$ = "": lPlace = 1
        Else
            test$ = a(pop - 1)
            If find%(fList(), test$) > 0 Then
                fun$ = test$: lPlace = pop - 1
            Else
                fun$ = "": lPlace = pop
            End If
        End If
        po = 1
        For i = pop + 1 To UBound(a)
            If a(i) = "(" Then po = po + 1
            If a(i) = ")" Then po = po - 1
            If po = 0 Then rPlace = i: Exit For
        Next
        ReDim inner(1 To 1) As String: index = 0: recurs = 0
        For i = (pop + 1) To (rPlace - 1)
            index = index + 1
            ReDim _Preserve inner(1 To index) As String
            inner(index) = a(i)
            If find%(oList(), a(i)) > 0 Then recurs = -1
        Next
        If recurs Then innerV$ = evalW$(inner()) Else innerV$ = a(pop + 1)
        innerVal = Val(innerV$)
 
        Select Case fun$
            Case "": m$ = innerV$
            Case "int": m$ = ls$(Int(innerVal))
            Case "not": If Int(innerVal) = 0 Then m$ = "-1" Else m$ = "0"
            Case "sin": If DFlag Then m$ = ls$(Sin(RAD * innerVal)) Else m$ = ls$(Sin(innerVal))
            Case "cos": If DFlag Then m$ = ls$(Cos(RAD * innerVal)) Else m$ = ls$(Cos(innerVal))
            Case "tan": If DFlag Then m$ = ls$(Tan(RAD * innerVal)) Else m$ = ls$(Tan(innerVal))
            Case "asin": If DFlag Then m$ = ls$(_Asin(RAD * innerVal)) Else m$ = ls$(_Asin(innerVal))
            Case "acos": If DFlag Then m$ = ls$(_Acos(RAD * innerVal)) Else m$ = ls$(_Acos(innerVal))
            Case "atan": If DFlag Then m$ = ls$((DEG * Atn(innerVal))) Else m$ = ls$(Atn(innerVal))
            Case "log"
                If innerVal > 0 Then
                    m$ = ls$(Log(innerVal))
                Else
                    EvalErr$ = "LOG only works on numbers > 0.": Exit Function
                End If
            Case "exp" 'the error limit is inconsistent in JB
                If -745 <= innerVal And innerVal <= 709 Then 'your system may have different results
                    m$ = ls$(Exp(innerVal))
                Else
                    'what the heck???? 708 works fine all alone as limit ?????
                    EvalErr$ = "EXP(n) only works for n = -745 to 709.": Exit Function
                End If
            Case "sqr"
                If innerVal >= 0 Then
                    m$ = ls$(Sqr(innerVal))
                Else
                    EvalErr$ = "SQR only works for numbers >= 0.": Exit Function
                End If
            Case "rad": m$ = ls$(innerVal * RAD)
            Case "deg": m$ = ls$(innerVal * DEG)
            Case Else: EvalErr$ = "Unidentified function " + fun$: Exit Function
        End Select
        If debug Then
            Print "lPlace, rPlace"; lPlace, rPlace
        End If
        arrSubst a(), lPlace, rPlace, m$
        If debug Then
            Print "After arrSubst a() is:"
            For i = LBound(a) To UBound(a)
                Print a(i); " ";
            Next
            Print: Print
        End If
        pop = find%(a(), "(")
    Wend
 
    'all parenthesis cleared
    'ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
    For o = 1 To UBound(oList)
        op$ = oList(o)
        p = find%(a(), op$)
        While p > 0
            a = Val(a(p - 1))
            b = Val(a(p + 1))
            If debug Then
                Print Str$(a) + op$ + Str$(b)
            End If
            Select Case op$
                Case "%"
                    If b >= 2 Then
                        m$ = ls$(Int(a) Mod Int(b))
                    Else
                        EvalErr$ = "For a Mod b, b value < 2."
                        Exit Function
                    End If
                Case "^"
                    If Int(b) = b Or a >= 0 Then
                        m$ = ls$(a ^ b)
                    Else
                        EvalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
                        Exit Function
                    End If
                Case "/"
                    If b <> 0 Then
                        m$ = ls$(a / b)
                    Else
                        EvalErr$ = "Div by 0"
                        Exit Function
                    End If
                Case "*": m$ = ls$(a * b)
                Case "-": m$ = ls$(a - b)
                Case "+": m$ = ls$(a + b)
                Case "=": If a = b Then m$ = "-1" Else m$ = "0"
                Case "<": If a < b Then m$ = "-1" Else m$ = "0"
                Case ">": If a > b Then m$ = "-1" Else m$ = "0"
                Case "<=": If a <= b Then m$ = "-1" Else m$ = "0"
                Case ">=": If a >= b Then m$ = "-1" Else m$ = "0"
                Case "<>": If a <> b Then m$ = "-1" Else m$ = "0"
                Case "and": If a <> 0 And b <> 0 Then m$ = "-1" Else m$ = "0"
                Case "or": If a <> 0 Or b <> 0 Then m$ = "-1" Else m$ = "0"
                    ' This is NOT a Binary Op!!
                    'Case "not": If b = 0 Then m$ = ls$(-1) Else m$ = ls$(0) 'use b as nothing should be left of not
            End Select
            arrSubst a(), p - 1, p + 1, m$
 
            If debug Then
                Print "a() reloaded after " + op$ + " as:"
                For i = LBound(a) To UBound(a)
                    Print a(i); ", ";
                Next
                Print: Print
            End If
 
            p = find%(a(), op$)
        Wend
    Next
    fun$ = ""
    For i = LBound(a) To UBound(a)
        fun$ = fun$ + " " + a(i)
    Next
    evalW$ = LTrim$(fun$)
End Function
 
Sub arrSubst (a() As String, substLow As Long, substHigh As Long, subst As String)
    Dim i As Long, index As Long
    a(substLow) = subst: index = substLow + 1
    For i = substHigh + 1 To UBound(a)
        a(index) = a(i): index = index + 1
    Next
    ReDim _Preserve a(LBound(a) To UBound(a) + substLow - substHigh)
End Sub
 
'notes: REDIM the array(0) to be loaded before calling Split '<<<<<<<<<<<<<<<<<<<<<<< IMPORTANT!!!!
Sub Split (mystr As String, delim As String, arr() As String)
    ' bplus modifications of Galleon fix of Bulrush Split reply #13
    ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
    ' this sub further developed and tested here: \test\Strings\Split test.bas
    ' 2018-09-16 modified for base 1 arrays
    Dim copy As String, p As Long, curpos As Long, arrpos As Long, lc As Long, dpos As Long
    copy = mystr 'make copy since we are messing with mystr
    'special case if delim is space, probably want to remove all excess space
    If delim = " " Then
        copy = RTrim$(LTrim$(copy))
        p = InStr(copy, "  ")
        While p > 0
            copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
            p = InStr(copy, "  ")
        Wend
    End If
    ReDim arr(1 To 1) 'clear it
    curpos = 1
    arrpos = 1
    lc = Len(copy)
    dpos = InStr(curpos, copy, delim)
    Do Until dpos = 0
        arr(arrpos) = Mid$(copy, curpos, dpos - curpos)
        arrpos = arrpos + 1
        ReDim _Preserve arr(1 To arrpos + 1) As String
        curpos = dpos + Len(delim)
        dpos = InStr(curpos, copy, delim)
    Loop
    arr(arrpos) = Mid$(copy, curpos)
    ReDim _Preserve arr(1 To arrpos) As String
End Sub
 
'assume a() is base 1 array so if find comes back as 0 then found nothing
Function find% (a() As String, s$)
    Dim i%
    For i% = LBound(a) To UBound(a)
        If a(i%) = s$ Then find% = i%: Exit Function
    Next
End Function
 
'ltrim a number float
Function ls$ (n As _Float)
    ls$ = LTrim$(Str$(n))
End Function
 

Some languages have a built in Eval function you can use. SmallBASIC did and I was able to build a hundred line Interpreter (Double, Triple, Quadruple, ... parking allowed ie use of : to load up the lines to come in <=100 lines.
This was a challenge at another forum that I managed to impress some people. SmallBASIC is just an Interpreter nothing Runs independent of the SmallBASIC.exe.

But here in the land of QB64 we don't have this marvelous function (we probably could, I think such a function by Steve is being used for Constants calculations as I recall and of course our QB64 need to use something like that too or maybe uses from the language that translates it to something compliable, but I digress...)
I was just curious how that code for a 100 line Interpreter would do with an Eval Function, so I built one and it does just fine! PLUS QB64 compiles programs so my Interpreter I build can stand alone on it's own without QB64.exe to Run in the OS it's compiled for.

Eval functions can be used for many things, because it does formulas on the fly and with better ones you can use variables and plug-in values when needed.

You know when you do an IF X Then line in Basic, that X has to be evaluated down to True Or False values, key to Interpreters ability to decide which route to take in the flow chart of the program.

All those lines on the right side of = have to be evaluated down to a value that get's associated with the variable name on the left of the =.

You can build Interpreters without Eval but it takes several more lines to get a formula with variables boiled down to a single value. And they are not as fun to code nor debug as a Basic and other regular PL's.

PS To use NOT with this Eval Function, use it like a function with parenthesis wrapping the expression you are NOTing.

SMcNeill · « **Reply #1 on:** February 16, 2021, 12:54:10 am »

I always love seeing how other people come up with EVAL type routines -- and I'm always amazed at how they do a lot of the same things as mine, in about half the code! Here's my Evaluate_Expression routine to compare:

Code: QB64: [Select]

REDIM SHARED OName(1000) AS STRING 'Operation Name
REDIM SHARED PL(1000) AS INTEGER 'Priority Level
REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name Conversion variables.
Set_OrderOfOperations
 
PRINT Evaluate_Expression("444%%"), 444%% 'which should be -68 as a _BYTE can't hold a value so large
PRINT Evaluate_Expression("19 * 444%%"), 19 * -68
 
DO
    INPUT "Give me something to test and evaluate => "; t$
    IF t$ = "" THEN EXIT DO
    PRINT Evaluate_Expression(t$)
LOOP
SYSTEM
 
'Steve Subs/Functins for _MATH support with CONST
FUNCTION Evaluate_Expression$ (e$)
    t$ = e$ 'So we preserve our original data, we parse a temp copy of it
    PreParse t$
 
 
    IF LEFT$(t$, 5) = "ERROR" THEN Evaluate_Expression$ = t$: EXIT FUNCTION
 
    'Deal with brackets first
    exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
 
    DO
        Eval_E = INSTR(exp$, ")")
        IF Eval_E > 0 THEN
            c = 0
            DO UNTIL Eval_E - c <= 0
                c = c + 1
                IF Eval_E THEN
                    IF MID$(exp$, Eval_E - c, 1) = "(" THEN EXIT DO
                END IF
            LOOP
            s = Eval_E - c + 1
            IF s < 1 THEN Evaluate_Expression$ = "ERROR -- BAD () Count": EXIT FUNCTION
            eval$ = " " + MID$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
 
            ParseExpression eval$
            eval$ = LTRIM$(RTRIM$(eval$))
            IF LEFT$(eval$, 5) = "ERROR" THEN Evaluate_Expression$ = eval$: EXIT FUNCTION
            exp$ = DWD(LEFT$(exp$, s - 2) + eval$ + MID$(exp$, Eval_E + 1))
            IF MID$(exp$, 1, 1) = "N" THEN MID$(exp$, 1) = "-"
        END IF
    LOOP UNTIL Eval_E = 0
    c = 0
    DO
        c = c + 1
        SELECT CASE MID$(exp$, c, 1)
            CASE "0" TO "9", ".", "-" 'At this point, we should only have number values left.
            CASE ELSE: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + exp$ + ") ": EXIT FUNCTION
        END SELECT
    LOOP UNTIL c >= LEN(exp$)
 
    Evaluate_Expression$ = exp$
END FUNCTION
 
 
 
SUB ParseExpression (exp$)
    DIM num(10) AS STRING
    'PRINT exp$
    exp$ = DWD(exp$)
    'We should now have an expression with no () to deal with
 
    FOR J = 1 TO 250
        lowest = 0
        DO UNTIL lowest = LEN(exp$)
            lowest = LEN(exp$): OpOn = 0
            FOR P = 1 TO UBOUND(OName)
                'Look for first valid operator
                IF J = PL(P) THEN 'Priority levels match
                    IF LEFT$(exp$, 1) = "-" THEN startAt = 2 ELSE startAt = 1
                    op = INSTR(startAt, exp$, OName(P))
                    IF op = 0 AND LEFT$(OName(P), 1) = "_" AND qb64prefix_set = 1 THEN
                        'try again without prefix
                        op = INSTR(startAt, exp$, MID$(OName(P), 2))
                        IF op > 0 THEN
                            exp$ = LEFT$(exp$, op - 1) + "_" + MID$(exp$, op)
                            lowest = lowest + 1
                        END IF
                    END IF
                    IF op > 0 AND op < lowest THEN lowest = op: OpOn = P
                END IF
            NEXT
            IF OpOn = 0 THEN EXIT DO 'We haven't gotten to the proper PL for this OP to be processed yet.
            IF LEFT$(exp$, 1) = "-" THEN startAt = 2 ELSE startAt = 1
            op = INSTR(startAt, exp$, OName(OpOn))
 
            numset = 0
 
            '*** SPECIAL OPERATION RULESETS
            IF OName(OpOn) = "-" THEN 'check for BOOLEAN operators before the -
                SELECT CASE MID$(exp$, op - 3, 3)
                    CASE "NOT", "XOR", "AND", "EQV", "IMP"
                        EXIT DO 'Not an operator, it's a negative
                END SELECT
                IF MID$(exp$, op - 3, 2) = "OR" THEN EXIT DO 'Not an operator, it's a negative
            END IF
 
            IF op THEN
                c = LEN(OName(OpOn)) - 1
                DO
                    SELECT CASE MID$(exp$, op + c + 1, 1)
                        CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
                        CASE "-" 'We need to check if it's a minus or a negative
                            IF OName(OpOn) = "_PI" OR numset THEN EXIT DO
                        CASE ",": numset = 0
                        CASE ELSE 'Not a valid digit, we found our separator
                            EXIT DO
                    END SELECT
                    c = c + 1
                LOOP UNTIL op + c >= LEN(exp$)
                E = op + c
 
                c = 0
                DO
                    c = c + 1
                    SELECT CASE MID$(exp$, op - c, 1)
                        CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
                        CASE "-" 'We need to check if it's a minus or a negative
                            c1 = c
                            bad = 0
                            DO
                                c1 = c1 + 1
                                SELECT CASE MID$(exp$, op - c1, 1)
                                    CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
                                        bad = -1
                                        EXIT DO 'It's a minus sign
                                    CASE ELSE
                                        'It's a negative sign and needs to count as part of our numbers
                                END SELECT
                            LOOP UNTIL op - c1 <= 0
                            IF bad THEN EXIT DO 'We found our seperator
                        CASE ELSE 'Not a valid digit, we found our separator
                            EXIT DO
                    END SELECT
                LOOP UNTIL op - c <= 0
                s = op - c
                num(1) = MID$(exp$, s + 1, op - s - 1) 'Get our first number
                num(2) = MID$(exp$, op + LEN(OName(OpOn)), E - op - LEN(OName(OpOn)) + 1) 'Get our second number
                IF MID$(num(1), 1, 1) = "N" THEN MID$(num(1), 1) = "-"
                IF MID$(num(2), 1, 1) = "N" THEN MID$(num(2), 1) = "-"
                IF num(1) = "-" THEN
                    num(3) = "N" + EvaluateNumbers(OpOn, num())
                ELSE
                    num(3) = EvaluateNumbers(OpOn, num())
                END IF
                IF MID$(num(3), 1, 1) = "-" THEN MID$(num(3), 1) = "N"
                IF LEFT$(num(3), 5) = "ERROR" THEN exp$ = num(3): EXIT SUB
                exp$ = LTRIM$(N2S(DWD(LEFT$(exp$, s) + RTRIM$(LTRIM$(num(3))) + MID$(exp$, E + 1))))
            END IF
            op = 0
        LOOP
    NEXT
 
END SUB
 
 
 
SUB Set_OrderOfOperations
    'PL sets our priortity level. 1 is highest to 65535 for the lowest.
    'I used a range here so I could add in new priority levels as needed.
    'OName ended up becoming the name of our commands, as I modified things.... Go figure!  LOL!
    REDIM OName(10000) AS STRING, PL(10000) AS INTEGER
    'Constants get evaluated first, with a Priority Level of 1
 
    i = i + 1: OName(i) = "C_UOF": PL(i) = 5 'convert to unsigned offset
    i = i + 1: OName(i) = "C_OF": PL(i) = 5 'convert to offset
    i = i + 1: OName(i) = "C_UBY": PL(i) = 5 'convert to unsigned byte
    i = i + 1: OName(i) = "C_BY": PL(i) = 5 'convert to byte
    i = i + 1: OName(i) = "C_UIN": PL(i) = 5 'convert to unsigned integer
    i = i + 1: OName(i) = "C_IN": PL(i) = 5 'convert to integer
    i = i + 1: OName(i) = "C_UIF": PL(i) = 5 'convert to unsigned int64
    i = i + 1: OName(i) = "C_IF": PL(i) = 5 'convert to int64
    i = i + 1: OName(i) = "C_ULO": PL(i) = 5 'convert to unsigned long
    i = i + 1: OName(i) = "C_LO": PL(i) = 5 'convert to long
    i = i + 1: OName(i) = "C_SI": PL(i) = 5 'convert to single
    i = i + 1: OName(i) = "C_FL": PL(i) = 5 'convert to float
    i = i + 1: OName(i) = "C_DO": PL(i) = 5 'convert to double
    i = i + 1: OName(i) = "C_UBI": PL(i) = 5 'convert to unsigned bit
    i = i + 1: OName(i) = "C_BI": PL(i) = 5 'convert to bit
 
    'Then Functions with PL 10
    i = i + 1:: OName(i) = "_PI": PL(i) = 10
    i = i + 1: OName(i) = "_ACOS": PL(i) = 10
    i = i + 1: OName(i) = "_ASIN": PL(i) = 10
    i = i + 1: OName(i) = "_ARCSEC": PL(i) = 10
    i = i + 1: OName(i) = "_ARCCSC": PL(i) = 10
    i = i + 1: OName(i) = "_ARCCOT": PL(i) = 10
    i = i + 1: OName(i) = "_SECH": PL(i) = 10
    i = i + 1: OName(i) = "_CSCH": PL(i) = 10
    i = i + 1: OName(i) = "_COTH": PL(i) = 10
    i = i + 1: OName(i) = "COS": PL(i) = 10
    i = i + 1: OName(i) = "SIN": PL(i) = 10
    i = i + 1: OName(i) = "TAN": PL(i) = 10
    i = i + 1: OName(i) = "LOG": PL(i) = 10
    i = i + 1: OName(i) = "EXP": PL(i) = 10
    i = i + 1: OName(i) = "ATN": PL(i) = 10
    i = i + 1: OName(i) = "_D2R": PL(i) = 10
    i = i + 1: OName(i) = "_D2G": PL(i) = 10
    i = i + 1: OName(i) = "_R2D": PL(i) = 10
    i = i + 1: OName(i) = "_R2G": PL(i) = 10
    i = i + 1: OName(i) = "_G2D": PL(i) = 10
    i = i + 1: OName(i) = "_G2R": PL(i) = 10
    i = i + 1: OName(i) = "ABS": PL(i) = 10
    i = i + 1: OName(i) = "SGN": PL(i) = 10
    i = i + 1: OName(i) = "INT": PL(i) = 10
    i = i + 1: OName(i) = "_ROUND": PL(i) = 10
    i = i + 1: OName(i) = "_CEIL": PL(i) = 10
    i = i + 1: OName(i) = "FIX": PL(i) = 10
    i = i + 1: OName(i) = "_SEC": PL(i) = 10
    i = i + 1: OName(i) = "_CSC": PL(i) = 10
    i = i + 1: OName(i) = "_COT": PL(i) = 10
    i = i + 1: OName(i) = "ASC": PL(i) = 10
    i = i + 1: OName(i) = "CHR$": PL(i) = 10
    i = i + 1: OName(i) = "C_RG": PL(i) = 10 '_RGB32 converted
    i = i + 1: OName(i) = "C_RA": PL(i) = 10 '_RGBA32 converted
    i = i + 1: OName(i) = "_RGB": PL(i) = 10
    i = i + 1: OName(i) = "_RGBA": PL(i) = 10
    i = i + 1: OName(i) = "C_RX": PL(i) = 10 '_RED32 converted
    i = i + 1: OName(i) = "C_GR": PL(i) = 10 ' _GREEN32 converted
    i = i + 1: OName(i) = "C_BL": PL(i) = 10 '_BLUE32 converted
    i = i + 1: OName(i) = "C_AL": PL(i) = 10 '_ALPHA32 converted
    i = i + 1: OName(i) = "_RED": PL(i) = 10
    i = i + 1: OName(i) = "_GREEN": PL(i) = 10
    i = i + 1: OName(i) = "_BLUE": PL(i) = 10
    i = i + 1: OName(i) = "_ALPHA": PL(i) = 10
 
    'Exponents with PL 20
    i = i + 1: OName(i) = "^": PL(i) = 20
    i = i + 1: OName(i) = "SQR": PL(i) = 20
    i = i + 1: OName(i) = "ROOT": PL(i) = 20
    'Multiplication and Division PL 30
    i = i + 1: OName(i) = "*": PL(i) = 30
    i = i + 1: OName(i) = "/": PL(i) = 30
    'Integer Division PL 40
    i = i + 1: OName(i) = "\": PL(i) = 40
    'MOD PL 50
    i = i + 1: OName(i) = "MOD": PL(i) = 50
    'Addition and Subtraction PL 60
    i = i + 1: OName(i) = "+": PL(i) = 60
    i = i + 1: OName(i) = "-": PL(i) = 60
 
    'Relational Operators =, >, <, <>, <=, >=   PL 70
    i = i + 1: OName(i) = "<>": PL(i) = 70 'These next three are just reversed symbols as an attempt to help process a common typo
    i = i + 1: OName(i) = "><": PL(i) = 70
    i = i + 1: OName(i) = "<=": PL(i) = 70
    i = i + 1: OName(i) = ">=": PL(i) = 70
    i = i + 1: OName(i) = "=<": PL(i) = 70 'I personally can never keep these things straight.  Is it < = or = <...
    i = i + 1: OName(i) = "=>": PL(i) = 70 'Who knows, check both!
    i = i + 1: OName(i) = ">": PL(i) = 70
    i = i + 1: OName(i) = "<": PL(i) = 70
    i = i + 1: OName(i) = "=": PL(i) = 70
    'Logical Operations PL 80+
    i = i + 1: OName(i) = "NOT": PL(i) = 80
    i = i + 1: OName(i) = "AND": PL(i) = 90
    i = i + 1: OName(i) = "OR": PL(i) = 100
    i = i + 1: OName(i) = "XOR": PL(i) = 110
    i = i + 1: OName(i) = "EQV": PL(i) = 120
    i = i + 1: OName(i) = "IMP": PL(i) = 130
    i = i + 1: OName(i) = ",": PL(i) = 1000
 
    REDIM _PRESERVE OName(i) AS STRING, PL(i) AS INTEGER
END SUB
 
FUNCTION EvaluateNumbers$ (p, num() AS STRING)
    DIM n1 AS _FLOAT, n2 AS _FLOAT, n3 AS _FLOAT
    'PRINT "EVALNUM:"; OName(p), num(1), num(2)
 
    IF _TRIM$(num(1)) = "" THEN num(1) = "0"
 
    IF PL(p) >= 20 AND (LEN(_TRIM$(num(1))) = 0 OR LEN(_TRIM$(num(2))) = 0) THEN
        EvaluateNumbers$ = "ERROR - Missing operand": EXIT FUNCTION
    END IF
 
    IF INSTR(num(1), ",") THEN
        EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": EXIT FUNCTION
    END IF
    l2 = INSTR(num(2), ",")
    IF l2 THEN
        SELECT CASE OName(p) 'only certain commands should pass a comma value
            CASE "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "C_BL", "_ALPHA"
            CASE ELSE
                C$ = MID$(num(2), l2)
                num(2) = LEFT$(num(2), l2 - 1)
        END SELECT
    END IF
 
    SELECT CASE PL(p) 'divide up the work so we want do as much case checking
        CASE 5 'Type conversions
            'Note, these are special cases and work with the number BEFORE the command and not after
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "C_UOF": n1~%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%&)))
                CASE "C_ULO": n1%& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%&)))
                CASE "C_UBY": n1~%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%%)))
                CASE "C_UIN": n1~% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~%)))
                CASE "C_BY": n1%% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%%)))
                CASE "C_IN": n1% = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1%)))
                CASE "C_UIF": n1~&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&&)))
                CASE "C_OF": n1~& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~&)))
                CASE "C_IF": n1&& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&&)))
                CASE "C_LO": n1& = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1&)))
                CASE "C_UBI": n1~` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1~`)))
                CASE "C_BI": n1` = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1`)))
                CASE "C_FL": n1## = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1##)))
                CASE "C_DO": n1# = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1#)))
                CASE "C_SI": n1! = VAL(num(1)): EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1!)))
            END SELECT
            EXIT FUNCTION
        CASE 10 'functions
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "_PI"
                    n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
                    IF num(2) <> "" THEN n1 = n1 * VAL(num(2))
                CASE "_ACOS": n1 = _ACOS(VAL(num(2)))
                CASE "_ASIN": n1 = _ASIN(VAL(num(2)))
                CASE "_ARCSEC": n1 = _ARCSEC(VAL(num(2)))
                CASE "_ARCCSC": n1 = _ARCCSC(VAL(num(2)))
                CASE "_ARCCOT": n1 = _ARCCOT(VAL(num(2)))
                CASE "_SECH": n1 = _SECH(VAL(num(2)))
                CASE "_CSCH": n1 = _CSCH(VAL(num(2)))
                CASE "_COTH": n1 = _COTH(VAL(num(2)))
                CASE "C_RG"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB32": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c1 = 0 THEN 'there's no comma in the command to parse.  It's a grayscale value
                        n = VAL(num(2))
                        n1 = _RGB32(n, n, n)
                    ELSEIF c2 = 0 THEN 'there's one comma and not 2.  It's grayscale with alpha.
                        n = VAL(LEFT$(num(2), c1))
                        n2 = VAL(MID$(num(2), c1 + 1))
                        n1 = _RGBA32(n, n, n, n2)
                    ELSEIF c3 = 0 THEN 'there's two commas.  It's _RGB values
                        n = VAL(LEFT$(num(2), c1))
                        n2 = VAL(MID$(num(2), c1 + 1))
                        n3 = VAL(MID$(num(2), c2 + 1))
                        n1 = _RGB32(n, n2, n3)
                    ELSEIF c4 = 0 THEN 'there's three commas.  It's _RGBA values
                        n = VAL(LEFT$(num(2), c1))
                        n2 = VAL(MID$(num(2), c1 + 1))
                        n3 = VAL(MID$(num(2), c2 + 1))
                        n4 = VAL(MID$(num(2), c3 + 1))
                        n1 = _RGBA32(n, n2, n3, n4)
                    ELSE 'we have more than three commas.  I have no idea WTH type of values got passed here!
                        EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
                    END IF
                CASE "C_RA"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": EXIT FUNCTION
                    'we have to have 3 commas; not more, not less.
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    n3 = VAL(MID$(num(2), c2 + 1))
                    n4 = VAL(MID$(num(2), c3 + 1))
                    n1 = _RGBA32(n, n2, n3, n4)
                CASE "_RGB"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGB": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c3 = 0 OR c4 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGB requires 4 parameters for Red, Green, Blue, ScreenMode.": EXIT FUNCTION
                    'we have to have 3 commas; not more, not less.
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    n3 = VAL(MID$(num(2), c2 + 1))
                    n4 = VAL(MID$(num(2), c3 + 1))
                    SELECT CASE n4
                        CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
                        CASE ELSE
                            EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n4) + ")": EXIT FUNCTION
                    END SELECT
                    t = _NEWIMAGE(1, 1, n4)
                    n1 = _RGB(n, n2, n3, t)
                    _FREEIMAGE t
                CASE "_RGBA"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null _RGBA": EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN c3 = INSTR(c2 + 1, n$, ",")
                    IF c3 THEN c4 = INSTR(c3 + 1, n$, ",")
                    IF c4 THEN c5 = INSTR(c4 + 1, n$, ",")
                    IF c4 = 0 OR c5 <> 0 THEN EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGBA requires 5 parameters for Red, Green, Blue, Alpha, ScreenMode.": EXIT FUNCTION
                    'we have to have 4 commas; not more, not less.
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    n3 = VAL(MID$(num(2), c2 + 1))
                    n4 = VAL(MID$(num(2), c3 + 1))
                    n5 = VAL(MID$(num(2), c4 + 1))
                    SELECT CASE n5
                        CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
                        CASE ELSE
                            EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n5) + ")": EXIT FUNCTION
                    END SELECT
                    t = _NEWIMAGE(1, 1, n5)
                    n1 = _RGBA(n, n2, n3, n4, t)
                    _FREEIMAGE t
                CASE "_RED", "_GREEN", "_BLUE", "_ALPHA"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
                    c1 = INSTR(n$, ",")
                    IF c1 = 0 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
                    IF c1 THEN c2 = INSTR(c1 + 1, n$, ",")
                    IF c2 THEN EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": EXIT FUNCTION
                    n = VAL(LEFT$(num(2), c1))
                    n2 = VAL(MID$(num(2), c1 + 1))
                    SELECT CASE n2
                        CASE 0 TO 2, 7 TO 13, 256, 32 'these are the good screen values
                        CASE ELSE
                            EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + STR$(n2) + ")": EXIT FUNCTION
                    END SELECT
                    t = _NEWIMAGE(1, 1, n4)
                    SELECT CASE OName(p)
                        CASE "_RED": n1 = _RED(n, t)
                        CASE "_BLUE": n1 = _BLUE(n, t)
                        CASE "_GREEN": n1 = _GREEN(n, t)
                        CASE "_ALPHA": n1 = _ALPHA(n, t)
                    END SELECT
                    _FREEIMAGE t
                CASE "C_RX", "C_GR", "C_BL", "C_AL"
                    n$ = num(2)
                    IF n$ = "" THEN EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): EXIT FUNCTION
                    n = VAL(num(2))
                    SELECT CASE OName(p)
                        CASE "C_RX": n1 = _RED32(n)
                        CASE "C_BL": n1 = _BLUE32(n)
                        CASE "C_GR": n1 = _GREEN32(n)
                        CASE "C_AL": n1 = _ALPHA32(n)
                    END SELECT
                CASE "COS": n1 = COS(VAL(num(2)))
                CASE "SIN": n1 = SIN(VAL(num(2)))
                CASE "TAN": n1 = TAN(VAL(num(2)))
                CASE "LOG": n1 = LOG(VAL(num(2)))
                CASE "EXP": n1 = EXP(VAL(num(2)))
                CASE "ATN": n1 = ATN(VAL(num(2)))
                CASE "_D2R": n1 = 0.0174532925 * (VAL(num(2)))
                CASE "_D2G": n1 = 1.1111111111 * (VAL(num(2)))
                CASE "_R2D": n1 = 57.2957795 * (VAL(num(2)))
                CASE "_R2G": n1 = 0.015707963 * (VAL(num(2)))
                CASE "_G2D": n1 = 0.9 * (VAL(num(2)))
                CASE "_G2R": n1 = 63.661977237 * (VAL(num(2)))
                CASE "ABS": n1 = ABS(VAL(num(2)))
                CASE "SGN": n1 = SGN(VAL(num(2)))
                CASE "INT": n1 = INT(VAL(num(2)))
                CASE "_ROUND": n1 = _ROUND(VAL(num(2)))
                CASE "_CEIL": n1 = _CEIL(VAL(num(2)))
                CASE "FIX": n1 = FIX(VAL(num(2)))
                CASE "_SEC": n1 = _SEC(VAL(num(2)))
                CASE "_CSC": n1 = _CSC(VAL(num(2)))
                CASE "_COT": n1 = _COT(VAL(num(2)))
            END SELECT
        CASE 20 TO 60 'Math Operators
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "^": n1 = VAL(num(1)) ^ VAL(num(2))
                CASE "SQR": n1 = SQR(VAL(num(2)))
                CASE "ROOT"
                    n1 = VAL(num(1)): n2 = VAL(num(2))
                    IF n2 = 1 THEN EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))): EXIT FUNCTION
                    IF n1 < 0 AND n2 >= 1 THEN sign = -1: n1 = -n1 ELSE sign = 1
                    n3 = 1## / n2
                    IF n3 <> INT(n3) AND n2 < 1 THEN sign = SGN(n1): n1 = ABS(n1)
                    n1 = sign * (n1 ^ n3)
                CASE "*": n1 = VAL(num(1)) * VAL(num(2))
                CASE "/"
                    IF VAL(num(2)) <> 0 THEN
                        n1 = VAL(num(1)) / VAL(num(2))
                    ELSE
                        EvaluateNumbers$ = "ERROR - Division By Zero"
                        EXIT FUNCTION
                    END IF
                CASE "\"
                    IF VAL(num(2)) <> 0 THEN
                        n1 = VAL(num(1)) \ VAL(num(2))
                    ELSE
                        EvaluateNumbers$ = "ERROR - Division By Zero"
                        EXIT FUNCTION
                    END IF
                CASE "MOD"
                    IF VAL(num(2)) <> 0 THEN
                        n1 = VAL(num(1)) MOD VAL(num(2))
                    ELSE
                        EvaluateNumbers$ = "ERROR - Division By Zero"
                        EXIT FUNCTION
                    END IF
                CASE "+": n1 = VAL(num(1)) + VAL(num(2))
                CASE "-":
                    n1 = VAL(num(1)) - VAL(num(2))
            END SELECT
        CASE 70 'Relational Operators =, >, <, <>, <=, >=
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "=": n1 = VAL(num(1)) = VAL(num(2))
                CASE ">": n1 = VAL(num(1)) > VAL(num(2))
                CASE "<": n1 = VAL(num(1)) < VAL(num(2))
                CASE "<>", "><": n1 = VAL(num(1)) <> VAL(num(2))
                CASE "<=", "=<": n1 = VAL(num(1)) <= VAL(num(2))
                CASE ">=", "=>": n1 = VAL(num(1)) >= VAL(num(2))
            END SELECT
        CASE ELSE 'a value we haven't processed elsewhere
            SELECT CASE OName(p) 'Depending on our operator..
                CASE "NOT": n1 = NOT VAL(num(2))
                CASE "AND": n1 = VAL(num(1)) AND VAL(num(2))
                CASE "OR": n1 = VAL(num(1)) OR VAL(num(2))
                CASE "XOR": n1 = VAL(num(1)) XOR VAL(num(2))
                CASE "EQV": n1 = VAL(num(1)) EQV VAL(num(2))
                CASE "IMP": n1 = VAL(num(1)) IMP VAL(num(2))
            END SELECT
    END SELECT
 
    EvaluateNumbers$ = RTRIM$(LTRIM$(STR$(n1))) + C$
END FUNCTION
 
FUNCTION DWD$ (exp$) 'Deal With Duplicates
    'To deal with duplicate operators in our code.
    'Such as --  becomes a +
    '++ becomes a +
    '+- becomes a -
    '-+ becomes a -
    t$ = exp$
    DO
        bad = 0
        DO
            l = INSTR(t$, "++")
            IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        DO
            l = INSTR(t$, "+-")
            IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        DO
            l = INSTR(t$, "-+")
            IF l THEN t$ = LEFT$(t$, l - 1) + "-" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
        DO
            l = INSTR(t$, "--")
            IF l THEN t$ = LEFT$(t$, l - 1) + "+" + MID$(t$, l + 2): bad = -1
        LOOP UNTIL l = 0
    LOOP UNTIL NOT bad
    DWD$ = t$
END FUNCTION
 
SUB PreParse (e$)
    DIM f AS _FLOAT
    STATIC TotalPrefixedPP_TypeMod AS LONG, TotalPP_TypeMod AS LONG
 
    IF PP_TypeMod(0) = "" THEN
        REDIM PP_TypeMod(100) AS STRING, PP_ConvertedMod(100) AS STRING 'Large enough to hold all values to begin with
        PP_TypeMod(0) = "Initialized" 'Set so we don't do this section over and over, as we keep the values in shared memory.
        'and the below is a conversion list so symbols don't get cross confused.
        i = i + 1: PP_TypeMod(i) = "~`": PP_ConvertedMod(i) = "C_UBI" 'unsigned bit
        i = i + 1: PP_TypeMod(i) = "~%%": PP_ConvertedMod(i) = "C_UBY" 'unsigned byte
        i = i + 1: PP_TypeMod(i) = "~%&": PP_ConvertedMod(i) = "C_UOF" 'unsigned offset
        i = i + 1: PP_TypeMod(i) = "~%": PP_ConvertedMod(i) = "C_UIN" 'unsigned integer
        i = i + 1: PP_TypeMod(i) = "~&&": PP_ConvertedMod(i) = "C_UIF" 'unsigned integer64
        i = i + 1: PP_TypeMod(i) = "~&": PP_ConvertedMod(i) = "C_ULO" 'unsigned long
        i = i + 1: PP_TypeMod(i) = "`": PP_ConvertedMod(i) = "C_BI" 'bit
        i = i + 1: PP_TypeMod(i) = "%%": PP_ConvertedMod(i) = "C_BY" 'byte
        i = i + 1: PP_TypeMod(i) = "%&": PP_ConvertedMod(i) = "C_OF" 'offset
        i = i + 1: PP_TypeMod(i) = "%": PP_ConvertedMod(i) = "C_IN" 'integer
        i = i + 1: PP_TypeMod(i) = "&&": PP_ConvertedMod(i) = "C_IF" 'integer64
        i = i + 1: PP_TypeMod(i) = "&": PP_ConvertedMod(i) = "C_LO" 'long
        i = i + 1: PP_TypeMod(i) = "!": PP_ConvertedMod(i) = "C_SI" 'single
        i = i + 1: PP_TypeMod(i) = "##": PP_ConvertedMod(i) = "C_FL" 'float
        i = i + 1: PP_TypeMod(i) = "#": PP_ConvertedMod(i) = "C_DO" 'double
        i = i + 1: PP_TypeMod(i) = "_RGB32": PP_ConvertedMod(i) = "C_RG" 'rgb32
        i = i + 1: PP_TypeMod(i) = "_RGBA32": PP_ConvertedMod(i) = "C_RA" 'rgba32
        i = i + 1: PP_TypeMod(i) = "_RED32": PP_ConvertedMod(i) = "C_RX" 'red32
        i = i + 1: PP_TypeMod(i) = "_GREEN32": PP_ConvertedMod(i) = "C_GR" 'green32
        i = i + 1: PP_TypeMod(i) = "_BLUE32": PP_ConvertedMod(i) = "C_BL" 'blue32
        i = i + 1: PP_TypeMod(i) = "_ALPHA32": PP_ConvertedMod(i) = "C_AL" 'alpha32
        TotalPrefixedPP_TypeMod = i
        i = i + 1: PP_TypeMod(i) = "RGB32": PP_ConvertedMod(i) = "C_RG" 'rgb32
        i = i + 1: PP_TypeMod(i) = "RGBA32": PP_ConvertedMod(i) = "C_RA" 'rgba32
        i = i + 1: PP_TypeMod(i) = "RED32": PP_ConvertedMod(i) = "C_RX" 'red32
        i = i + 1: PP_TypeMod(i) = "GREEN32": PP_ConvertedMod(i) = "C_GR" 'green32
        i = i + 1: PP_TypeMod(i) = "BLUE32": PP_ConvertedMod(i) = "C_BL" 'blue32
        i = i + 1: PP_TypeMod(i) = "ALPHA32": PP_ConvertedMod(i) = "C_AL" 'alpha32
        TotalPP_TypeMod = i
        REDIM _PRESERVE PP_TypeMod(i) AS STRING, PP_ConvertedMod(i) AS STRING 'And then resized to just contain the necessary space in memory
    END IF
    t$ = e$
 
    'First strip all spaces
    t$ = ""
    FOR i = 1 TO LEN(e$)
        IF MID$(e$, i, 1) <> " " THEN t$ = t$ + MID$(e$, i, 1)
    NEXT
 
    t$ = UCASE$(t$)
    IF t$ = "" THEN e$ = "ERROR -- NULL string; nothing to evaluate": EXIT SUB
 
    'ERROR CHECK by counting our brackets
    l = 0
    DO
        l = INSTR(l + 1, t$, "("): IF l THEN c = c + 1
    LOOP UNTIL l = 0
    l = 0
    DO
        l = INSTR(l + 1, t$, ")"): IF l THEN c1 = c1 + 1
    LOOP UNTIL l = 0
    IF c <> c1 THEN e$ = "ERROR -- Bad Parenthesis:" + STR$(c) + "( vs" + STR$(c1) + ")": EXIT SUB
 
    'Modify so that NOT will process properly
    l = 0
    DO
        l = INSTR(l + 1, t$, "NOT")
        IF l THEN
            'We need to work magic on the statement so it looks pretty.
            ' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
            'Look for something not proper
            l1 = INSTR(l + 1, t$, "AND")
            IF l1 = 0 OR (INSTR(l + 1, t$, "OR") > 0 AND INSTR(l + 1, t$, "OR") < l1) THEN l1 = INSTR(l + 1, t$, "OR")
            IF l1 = 0 OR (INSTR(l + 1, t$, "XOR") > 0 AND INSTR(l + 1, t$, "XOR") < l1) THEN l1 = INSTR(l + 1, t$, "XOR")
            IF l1 = 0 OR (INSTR(l + 1, t$, "EQV") > 0 AND INSTR(l + 1, t$, "EQV") < l1) THEN l1 = INSTR(l + 1, t$, "EQV")
            IF l1 = 0 OR (INSTR(l + 1, t$, "IMP") > 0 AND INSTR(l + 1, t$, "IMP") < l1) THEN l1 = INSTR(l + 1, t$, "IMP")
            IF l1 = 0 THEN l1 = LEN(t$) + 1
            t$ = LEFT$(t$, l - 1) + "(" + MID$(t$, l, l1 - l) + ")" + MID$(t$, l + l1 - l)
            l = l + 3
            'PRINT t$
        END IF
    LOOP UNTIL l = 0
 
 
    uboundPP_TypeMod = TotalPrefixedPP_TypeMod
    IF qb64prefix_set = 1 THEN uboundPP_TypeMod = TotalPP_TypeMod
    FOR j = 1 TO uboundPP_TypeMod
        l = 0
        DO
            l = INSTR(l + 1, t$, PP_TypeMod(j))
            IF l = 0 THEN EXIT DO
            i = 0: l1 = 0: l2 = 0: lo = LEN(PP_TypeMod(j))
            DO
                IF PL(i) > 10 THEN
                    l2 = _INSTRREV(l, t$, OName$(i))
                    IF l2 > 0 AND l2 > l1 THEN l1 = l2
                END IF
                i = i + lo
            LOOP UNTIL i > UBOUND(PL)
            l$ = LEFT$(t$, l1)
            m$ = MID$(t$, l1 + 1, l - l1 - 1)
            r$ = PP_ConvertedMod(j) + MID$(t$, l + lo)
            'IF j > 15 THEN
            t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
            'ELSE
            'the first 15 commands need to properly place the parenthesis around the value we want to convert.
            't$ = l$ + "(" + m$ + ")" + r$
            'END IF
            l = l + 2 + LEN(PP_TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and  ")"
        LOOP
    NEXT
    'Check for bad operators before a ( bracket
    l = 0
    DO
        l = INSTR(l + 1, t$, "(")
        IF l > 0 AND l > 2 THEN 'Don't check the starting bracket; there's nothing before it.
            good = 0
            FOR i = 1 TO UBOUND(OName)
                m$ = MID$(t$, l - LEN(OName(i)), LEN(OName(i)))
                IF m$ = OName(i) THEN
                    good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                ELSE
                    IF LEFT$(OName(i), 1) = "_" AND qb64prefix_set = 1 THEN
                        'try without prefix
                        m$ = MID$(t$, l - (LEN(OName(i)) - 1), LEN(OName(i)) - 1)
                        IF m$ = MID$(OName(i), 2) THEN good = -1: EXIT FOR
                    END IF
                END IF
            NEXT
            IF NOT good THEN e$ = "ERROR - Improper operations before (.": EXIT SUB
            l = l + 1
        END IF
    LOOP UNTIL l = 0
 
    'Check for bad operators after a ) bracket
    l = 0
    DO
        l = INSTR(l + 1, t$, ")")
        IF l > 0 AND l < LEN(t$) THEN
            good = 0
            FOR i = 1 TO UBOUND(OName)
                m$ = MID$(t$, l + 1, LEN(OName(i)))
                IF m$ = OName(i) THEN
                    good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI
                ELSE
                    IF LEFT$(OName(i), 1) = "_" AND qb64prefix_set = 1 THEN
                        'try without prefix
                        m$ = MID$(t$, l + 1, LEN(OName(i)) - 1)
                        IF m$ = MID$(OName(i), 2) THEN good = -1: EXIT FOR
                    END IF
                END IF
            NEXT
            IF MID$(t$, l + 1, 1) = ")" THEN good = -1
            IF NOT good THEN e$ = "ERROR - Improper operations after ).": EXIT SUB
            l = l + 1
        END IF
    LOOP UNTIL l = 0 OR l = LEN(t$) 'last symbol is a bracket
 
    'Turn all &H (hex) numbers into decimal values for the program to process properly
    l = 0
    DO
        l = INSTR(t$, "&H")
        IF l THEN
            E = l + 1: finished = 0
            DO
                E = E + 1
                comp$ = MID$(t$, E, 1)
                SELECT CASE comp$
                    CASE "0" TO "9", "A" TO "F" 'All is good, our next digit is a number, continue to add to the hex$
                    CASE ELSE
                        good = 0
                        FOR i = 1 TO UBOUND(OName)
                            IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                        NEXT
                        IF NOT good THEN e$ = "ERROR - Improper &H value. (" + comp$ + ")": EXIT SUB
                        E = E - 1
                        finished = -1
                END SELECT
            LOOP UNTIL finished OR E = LEN(t$)
            t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(VAL(MID$(t$, l, E - l + 1))))) + MID$(t$, E + 1)
        END IF
    LOOP UNTIL l = 0
 
    'Turn all &B (binary) numbers into decimal values for the program to process properly
    l = 0
    DO
        l = INSTR(t$, "&B")
        IF l THEN
            E = l + 1: finished = 0
            DO
                E = E + 1
                comp$ = MID$(t$, E, 1)
                SELECT CASE comp$
                    CASE "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
                    CASE ELSE
                        good = 0
                        FOR i = 1 TO UBOUND(OName)
                            IF MID$(t$, E, LEN(OName(i))) = OName(i) AND PL(i) > 1 AND PL(i) <= 250 THEN good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                        NEXT
                        IF NOT good THEN e$ = "ERROR - Improper &B value. (" + comp$ + ")": EXIT SUB
                        E = E - 1
                        finished = -1
                END SELECT
            LOOP UNTIL finished OR E = LEN(t$)
            bin$ = MID$(t$, l + 2, E - l - 1)
            FOR i = 1 TO LEN(bin$)
                IF MID$(bin$, i, 1) = "1" THEN f = f + 2 ^ (LEN(bin$) - i)
            NEXT
            t$ = LEFT$(t$, l - 1) + LTRIM$(RTRIM$(STR$(f))) + MID$(t$, E + 1)
        END IF
    LOOP UNTIL l = 0
 
 
    't$ = N2S(t$)
    VerifyString t$
    e$ = t$
END SUB
 
 
 
SUB VerifyString (t$)
    'ERROR CHECK for unrecognized operations
    j = 1
    DO
        comp$ = MID$(t$, j, 1)
        SELECT CASE comp$
            CASE "0" TO "9", ".", "(", ")", ",": j = j + 1
            CASE ELSE
                good = 0
                extrachar = 0
                FOR i = 1 TO UBOUND(OName)
                    IF MID$(t$, j, LEN(OName(i))) = OName(i) THEN
                        good = -1: EXIT FOR 'We found an operator after our ), and it's not a CONST (like PI)
                    ELSE
                        IF LEFT$(OName(i), 1) = "_" AND qb64prefix_set = 1 THEN
                            'try without prefix
                            IF MID$(t$, j, LEN(OName(i)) - 1) = MID$(OName(i), 2) THEN
                                good = -1: extrachar = 1: EXIT FOR
                            END IF
                        END IF
                    END IF
                NEXT
                IF NOT good THEN t$ = "ERROR - Bad Operational value. (" + comp$ + ")": EXIT SUB
                j = j + (LEN(OName(i)) - extrachar)
        END SELECT
    LOOP UNTIL j > LEN(t$)
END SUB
 
FUNCTION N2S$ (exp$) 'scientific Notation to String
 
    t$ = LTRIM$(RTRIM$(exp$))
    IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
 
    dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
    ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
    check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
    IF check1 < 1 OR check1 > 1 THEN N2S = exp$: EXIT FUNCTION 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
 
    SELECT CASE l 'l now tells us where the SN starts at.
        CASE IS < dp: l = dp
        CASE IS < dm: l = dm
        CASE IS < ep: l = ep
        CASE IS < em: l = em
    END SELECT
 
    l$ = LEFT$(t$, l - 1) 'The left of the SN
    r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
 
 
    IF INSTR(l$, ".") THEN 'Location of the decimal, if any
        IF r&& > 0 THEN
            r&& = r&& - LEN(l$) + 2
        ELSE
            r&& = r&& + 1
        END IF
        l$ = LEFT$(l$, 1) + MID$(l$, 3)
    END IF
 
    SELECT CASE r&&
        CASE 0 'what the heck? We solved it already?
            'l$ = l$
        CASE IS < 0
            FOR i = 1 TO -r&&
                l$ = "0" + l$
            NEXT
            l$ = "0." + l$
        CASE ELSE
            FOR i = 1 TO r&&
                l$ = l$ + "0"
            NEXT
    END SELECT
 
    N2S$ = sign$ + l$
END FUNCTION

How you guys can break all your order of operations down into a single string to parse, amazes the BLEEP out of me. If I'm reading yours right @bplus, you store the order of operations in ops$? ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)

I've got mine broken down into a whole dang subroutine, with preparsing and everything else going on under the sun to check and sort parenthesis and all, even before that happens...

I always found the math part fairly simple: result = number(1) operation number(2) -- such as result = 3 * 4

But processing things in the proper order, is a real PITA! (At least, it is for me!)

bplus · « **Reply #2 on:** February 16, 2021, 12:28:33 pm »

Quote

How you guys can break all your order of operations down into a single string to parse, amazes the BLEEP out of me. If I'm reading yours right @bplus, you store the order of operations in ops$? ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)

@SMcNeill yeah, the list is giving the order of ops to do in each level of (). Steve you do alright when it comes to clever coding or getting the job with an elegant set of commands. PRINT USING a most recent example. ;-))

But to me the biggest hurdle to understanding an Eval Function is knowing to do the () levels recursively.

I just spent 14 hours chasing down a missing comma and a don't drop the spaces switch in a split command to finally get the not() function to work in SB1. 14 hours between getting it to work in Eval and getting it to work in SB1. Yikes!!!

But I think I got allot of other potential annoyances on the way. My Debug switched on program is giving pretty detailed picture how SB1 is processing the string, of course the screen output is a mess because of the excess stuff getting printed and clearing.

bplus · « **Reply #3 on:** February 16, 2021, 11:13:50 pm »

Eval as integrated and updated from SB1 modifications, error message changes so QB64 doesn't throw (as many) useless Subscript Out of Bounds errors but SB1 (Interpreter update) gives clues where they are coming from.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Eval 2021-02-21 from SB1 v2021-02-21" ' B+
' from: EVAL  2018-02-05 5:53 PM
' Goals do it without Wrd$ functions
' Do it for both string and math functions
 
' 2021-02-15  not is broken!!  fixed I think moved to Function list because NO is NOT a Bianary Operation!!!
' 2021-02-15 it looks like subtract and -number can be differentaited so that - for subtraction does Not
'            have to be wrapped in spaces, oh yeah oh yeah!
'              e$ = "2*-3--4+-0.25" ' returns -2.25 OK  -6 + 4 -.25
' completely retested all strings below, fixed not by moving it to the Function list,
' and removing it from the BINARY ops list because NOT is NOT a BINARY FUNCTION THAT REQUIRES TWO ARGUMENTS
' 2021-02-21 want to update Eval as SB1 exposes glaring errors or nuances to refine functionality.
 
' 2021-02-21 Eval from SB1 same date, err message in EvalW sub
' this has Split with option and acumulates Err$ =Err$ + Chr$(10) + "New Error:  description""
' How long does it take to run down the checklist here? 2PM start post at 2:55 PM < Hour
' slowed up by getting X back in for checking variable substitutions.
 
'
CONST XMAX = 1200
CONST YMAX = 720
 
SCREEN _NEWIMAGE(XMAX, YMAX, 32)
_SCREENMOVE 100, 0
 
DIM SHARED debug AS _BIT
debug = -1
 
'evaluate$ and evalW setup
DIM SHARED DFlag AS _BIT, Err$, X AS _FLOAT, RAD AS _FLOAT, DEG AS _FLOAT
DFlag = -1
Err$ = ""
X = 5 'changeable  '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  > might want to remove this in app see Evaulate$
RAD = _PI / 180.0
DEG = 180 / _PI
REDIM SHARED fList(1 TO 1) AS STRING
Split "int, sin, cos, tan, asin, acos, atan, log, exp, sqr, rad, deg, not", ", ", fList(), 0 ' add not function here
REDIM SHARED oList(1 TO 1) AS STRING
Split "^, %, /, *, -, +, =, <, >, <=, >=, <>, or, and", ", ", oList(), 0 ' not is NOT a Binary Op
 
'main dim
DIM e$, r$
'  tests
 
e$ = "PI" ' ok caps or not
e$ = "pi" 'ok
e$ = "1 +1"
e$ = "-1+1" 'ok     checking the infamous minus sign doing double duty of neg number or subtraction
e$ = "(5 - 7) * 2" '-4 ok
e$ = "(5-7)* 2" '-4 ok
e$ = "(-5--7)*2" '4 ok
e$ = "2*(-5-7)" ' -24  ok
e$ = "(-1--2)+(-3--4)" ' 2 ok 1 + 1
e$ = "x*x-2*x-3" ' x = 5 returns 12
 
' new not tests
e$ = "not-1" ' Wrong! syntax returns -1  but no error thrown
e$ = "not(-1)" ' fixed
e$ = "not(-1 or -1)" ' 0 ok fixed
e$ = "not(0)" ' -1 yeah good
e$ = "not(-8)"
e$ = "not (-1)" '  wrong syntax but this works????  because ( and ) can be wrapped in spaces
e$ = "not (0)" ' wrong syntax  but works???  it's because of way ( ) can be spaced or not
e$ = "-1 not" ' wrong syntax crash bang boom but the line is soooo wrong , no error
 
e$ = "-1 or 0" 'OK
e$ = "log(0)" 'err   new error message shows now 2021-02-21
e$ = "log(2)" 'see next close!!!
e$ = "exp(.69314718055)" 'inverse above  close enough
e$ = "exp(-745) " '-745 no err! -746 err!
e$ = "exp(-693) " ' FB -693 limit 1.0812... E-301 bottom limit no error on my system, -708 on another test
e$ = "exp( 709) " ' no err , FB 707 limit 8.21840... E+307no error on my system
e$ = "sqr(-10)" 'err
e$ = "-5 ^ 1.9" 'err good get err message
e$ = "2*-3--4+-0.25" ' returns -2.25 OK don't need to isolate - meant for subtraction !!! <<<<<<<<<<<<<<<<<<<<< see fixed 2021-02-15
e$ = "1+2*(3+((4*5)+(6*7*8))-9)/10" ' returns 71 OK  OK fixed!
e$ = " 1+2*(3-2*(3-2)*((2-4)*5-22/(7+2*(3-1))-1))+1" ' returns 60 OK
e$ = "1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2"
'' returns euler's 2.718 281 828 458 994 464 285 469 58 OK for as far as it goes 2.718 281 828 458 995 last digit off by 1  OK!!!
e$ = "(1.4 + 2^(19%4))/2" ' = 4.7 OK OK
e$ = "e^2" ' = 7.3890...
e$ = "PI/6" '= .52...
e$ = "x ^ (200/400)" ' = 2.23606... when sqr(x) x = 5
e$ = "x^2-2*x-15" ' = 0 when x = 5 good!
e$ = "e^ 8" ' > 2980.9594...
e$ = " log(2980.9594)" ' > 8.000..
e$ = "sin(x)^2 + cos(x)^2" ' > ~1
e$ = "atan(1)" 'should be 45 degrees if degrees flag on nope, correct in radians  fixed  2021-02-15
e$ = "atan(sin(30)/cos(30))" ' > 30 with DFlag = 1   2021-02-15 eeeh no? fixed  2021-02-15
e$ = ".3 + 2*10^-8" ' .30000002
e$ = "pi/6 < pi" ' -1 of course yeah my first Boolean!
e$ = "99 % 11 = 0"
e$ = "23 <= 22" ' 0?   of course!
e$ = "(99 % 9 = 0) and (not (  (23 < 22) or (5 < 3)  )) " ' (0) and ( not ((0) or (0) ) )  the first part is -1 so 0! 2nd part -1 so -1 and -1 = -1 ok!
 
' main after setting e$ ======================================================================  main
PRINT e$
r$ = Evaluate$(e$)
IF Err$ <> "" THEN PRINT "Error: "; Err$ ELSE PRINT "Expression = "; r$
PRINT "Done"
SLEEP
' ============================================================================================ main end
 
'this preps e$ string for actual evaluation function and makes call to it,
'checks results for error returns that or string form of result calculation
'the new goal is to do string functions along side math
FUNCTION Evaluate$ (e$)
    DIM b$, c$, w$
    DIM i AS INTEGER, po AS INTEGER
    ' isolateNeg = 0
    b$ = "" 'rebuild string with padded spaces
    'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
    FOR i = 1 TO LEN(e$) 'filter chars and count ()
        c$ = LCASE$(MID$(e$, i, 1))
        IF c$ = ")" THEN
            po = po - 1: b$ = b$ + " ) "
        ELSEIF c$ = "(" THEN
            po = po + 1: b$ = b$ + " ( "
        ELSEIF INSTR("+*/%^", c$) > 0 THEN
            b$ = b$ + " " + c$ + " "
        ELSEIF c$ = "-" THEN
            IF LEN(b$) > 0 THEN
                IF INSTR(".0123456789abcdefghijklmnopqrstuvwxyz)", RIGHT$(RTRIM$(b$), 1)) > 0 THEN
                    b$ = b$ + " " + c$ + " "
                ELSE
                    b$ = b$ + " " + c$
                END IF
            ELSE
                b$ = b$ + " " + c$
            END IF
        ELSEIF INSTR(" .0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 THEN
            b$ = b$ + c$
        END IF
        IF po < 0 THEN Err$ = Err$ + CHR$(10) + "Evaluate$ Error: Too many ) ": EXIT FUNCTION
    NEXT
    IF po <> 0 THEN Err$ = Err$ + CHR$(10) + "Evaluate$ Error: Unbalanced () ": EXIT FUNCTION
    REDIM ev(1 TO 1) AS STRING
    Split b$, " ", ev(), -1
    FOR i = LBOUND(ev) TO UBOUND(ev) 'subst constants
        IF ev(i) = "pi" THEN
            ev(i) = LTRIM$(STR$(_PI))
        ELSEIF ev(i) = "e" THEN
            ev(i) = LTRIM$(STR$(EXP(1)))
        ELSEIF ev(i) = "rnd" THEN
            RANDOMIZE TIMER
            ev(i) = LTRIM$(STR$(RND))
        ELSEIF ev(i) = "x" THEN ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> This plugged back in from SB1 transplant
            ev(i) = _TRIM$(STR$(X))
        END IF
    NEXT
    c$ = evalW$(ev())
    IF Err$ <> "" THEN Evaluate$ = Err$ ELSE Evaluate$ = c$
    IF debug THEN
        PRINT "Evaluate$ is returning:";
        IF Err$ <> "" THEN PRINT "Eval Error: "; Err$ ELSE PRINT " Value *" + c$ + "*"
        INPUT "Enter to continue..."; w$
    END IF
END FUNCTION
 
' the recursive part of EVAL
FUNCTION evalW$ (a() AS STRING)
    IF Err$ <> "" THEN EXIT FUNCTION
 
    DIM fun$, test$, innerV$, m$, op$
    DIM pop AS INTEGER, lPlace AS INTEGER, i AS INTEGER, rPlace AS INTEGER
    DIM po AS INTEGER, p AS INTEGER, o AS INTEGER, index AS INTEGER
    DIM recurs AS INTEGER
    DIM innerVal AS _FLOAT, a AS _FLOAT, b AS _FLOAT
    IF debug THEN
        PRINT "evalW rec'd a() as:"
        FOR i = LBOUND(a) TO UBOUND(a)
            PRINT a(i); ", ";
        NEXT
        PRINT: INPUT "OK enter"; test$: PRINT
    END IF
    pop = find%(a(), "(") 'parenthesis open place
    WHILE pop > 0
        IF pop = 1 THEN
            fun$ = "": lPlace = 1
        ELSE
            test$ = a(pop - 1)
            IF find%(fList(), test$) > 0 THEN
                fun$ = test$: lPlace = pop - 1
            ELSE
                fun$ = "": lPlace = pop
            END IF
        END IF
        po = 1
        FOR i = pop + 1 TO UBOUND(a)
            IF a(i) = "(" THEN po = po + 1
            IF a(i) = ")" THEN po = po - 1
            IF po = 0 THEN rPlace = i: EXIT FOR
        NEXT
        REDIM inner(1 TO 1) AS STRING: index = 0: recurs = 0
        FOR i = (pop + 1) TO (rPlace - 1)
            index = index + 1
            REDIM _PRESERVE inner(1 TO index) AS STRING
            inner(index) = a(i)
            IF find%(oList(), a(i)) > 0 THEN recurs = -1
        NEXT
        IF recurs THEN innerV$ = evalW$(inner()) ELSE innerV$ = a(pop + 1)
        innerVal = VAL(innerV$)
 
        SELECT CASE fun$
            CASE "": m$ = innerV$
            CASE "int": m$ = ls$(INT(innerVal))
            CASE "not": IF INT(innerVal) = 0 THEN m$ = "-1" ELSE m$ = "0"
            CASE "sin": IF DFlag THEN m$ = ls$(SIN(RAD * innerVal)) ELSE m$ = ls$(SIN(innerVal))
            CASE "cos": IF DFlag THEN m$ = ls$(COS(RAD * innerVal)) ELSE m$ = ls$(COS(innerVal))
            CASE "tan": IF DFlag THEN m$ = ls$(TAN(RAD * innerVal)) ELSE m$ = ls$(TAN(innerVal))
            CASE "asin": IF DFlag THEN m$ = ls$(_ASIN(RAD * innerVal)) ELSE m$ = ls$(_ASIN(innerVal))
            CASE "acos": IF DFlag THEN m$ = ls$(_ACOS(RAD * innerVal)) ELSE m$ = ls$(_ACOS(innerVal))
            CASE "atan": IF DFlag THEN m$ = ls$((DEG * ATN(innerVal))) ELSE m$ = ls$(ATN(innerVal))
            CASE "log"
                IF innerVal > 0 THEN
                    m$ = ls$(LOG(innerVal))
                ELSE
                    Err$ = Err$ + CHR$(10) + "EvalW error: LOG only works on numbers > 0.": EXIT FUNCTION
                END IF
            CASE "exp" 'the error limit is inconsistent in JB
                IF -745 <= innerVal AND innerVal <= 709 THEN 'your system may have different results
                    m$ = ls$(EXP(innerVal))
                ELSE
                    'what the heck???? 708 works fine all alone as limit ?????
                    Err$ = Err$ + CHR$(10) + "EvalW error: EXP(n) only works for n = -745 to 709.": EXIT FUNCTION
                END IF
            CASE "sqr"
                IF innerVal >= 0 THEN
                    m$ = ls$(SQR(innerVal))
                ELSE
                    Err$ = Err$ + CHR$(10) + "EvalW error: SQR only works for numbers >= 0.": EXIT FUNCTION
                END IF
            CASE "rad": m$ = ls$(innerVal * RAD)
            CASE "deg": m$ = ls$(innerVal * DEG)
            CASE ELSE: Err$ = Err$ + CHR$(10) + "EvalW error: Unidentified function " + fun$: EXIT FUNCTION
        END SELECT
        IF debug THEN
            PRINT "lPlace, rPlace"; lPlace, rPlace
        END IF
        arrSubst a(), lPlace, rPlace, m$
        IF debug THEN
            PRINT "After arrSubst a() is:"
            FOR i = LBOUND(a) TO UBOUND(a)
                PRINT a(i); " ";
            NEXT
            PRINT: PRINT
        END IF
        pop = find%(a(), "(")
    WEND
 
    'all parenthesis cleared
    'ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
    FOR o = 1 TO UBOUND(oList)
        op$ = oList(o)
        p = find%(a(), op$)
        WHILE p > 0
            ' 2021-02-21 added this error catcher doesn't help much but stops QB64 from throwing it's own
            ' This one might be more helpful in tracking down cause and fixing.
            IF p - 1 >= LBOUND(a) AND p + 1 <= UBOUND(a) THEN
                a = VAL(a(p - 1))
                b = VAL(a(p + 1))
                IF debug THEN
                    PRINT STR$(a) + op$ + STR$(b)
                END IF
            ELSE ' going to err out$
                Err$ = Err$ + CHR$(10) + "EvalW error: in binary ops, missing a or b value."
                EXIT SUB
            END IF
            SELECT CASE op$
                CASE "%"
                    IF b >= 2 THEN
                        m$ = ls$(INT(a) MOD INT(b))
                    ELSE
                        Err$ = Err$ + CHR$(10) + "EvalW error: For a Mod b, b value < 2."
                        EXIT FUNCTION
                    END IF
                CASE "^"
                    IF INT(b) = b OR a >= 0 THEN
                        m$ = ls$(a ^ b)
                    ELSE
                        Err$ = Err$ + CHR$(10) + "EvalW error: For a ^ b, a needs to be >= 0 when b not integer."
                        EXIT FUNCTION
                    END IF
                CASE "/"
                    IF b <> 0 THEN
                        m$ = ls$(a / b)
                    ELSE
                        Err$ = Err$ + CHR$(10) + "EvalW error: Div by 0"
                        EXIT FUNCTION
                    END IF
                CASE "*": m$ = ls$(a * b)
                CASE "-": m$ = ls$(a - b)
                CASE "+": m$ = ls$(a + b)
                CASE "=": IF a = b THEN m$ = "-1" ELSE m$ = "0"
                CASE "<": IF a < b THEN m$ = "-1" ELSE m$ = "0"
                CASE ">": IF a > b THEN m$ = "-1" ELSE m$ = "0"
                CASE "<=": IF a <= b THEN m$ = "-1" ELSE m$ = "0"
                CASE ">=": IF a >= b THEN m$ = "-1" ELSE m$ = "0"
                CASE "<>": IF a <> b THEN m$ = "-1" ELSE m$ = "0"
                CASE "and": IF a <> 0 AND b <> 0 THEN m$ = "-1" ELSE m$ = "0"
                CASE "or": IF a <> 0 OR b <> 0 THEN m$ = "-1" ELSE m$ = "0"
                    ' This is NOT a Binary Op!!
                    'Case "not": If b = 0 Then m$ = ls$(-1) Else m$ = ls$(0) 'use b as nothing should be left of not
            END SELECT
            arrSubst a(), p - 1, p + 1, m$
 
            IF debug THEN
                PRINT "a() reloaded after " + op$ + " as:"
                FOR i = LBOUND(a) TO UBOUND(a)
                    PRINT a(i); ", ";
                NEXT
                PRINT: PRINT
            END IF
 
            p = find%(a(), op$)
        WEND
    NEXT
    fun$ = ""
    FOR i = LBOUND(a) TO UBOUND(a)
        fun$ = fun$ + " " + a(i)
    NEXT
    evalW$ = LTRIM$(fun$)
END FUNCTION
 
'notes: Modified Split for Evaluate to share with other purpose apps,
' ie swith option to trim spaces to 1, mod made 2021 Feb for SB1 Interpreter
SUB Split (Mystr AS STRING, Delim AS STRING, Arr() AS STRING, DropExtraSpacesTF AS LONG)
    ' bplus modifications of Galleon fix of Bulrush Split reply #13
    ' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1612.0
    ' this sub further developed and tested here: \test\Strings\Split test.bas
    ' 2018-09-16 modified for base 1 arrays
    DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, lc AS LONG, dpos AS LONG
    copy = Mystr 'make copy since we are messing with mystr
 
    'special case if delim is space, probably want to remove all excess space
    IF DropExtraSpacesTF THEN
        IF Delim = " " THEN
            copy = _TRIM$(copy) '2021-2-16 change from ltrim and rtrim
            p = INSTR(copy, "  ")
            WHILE p > 0
                copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
                p = INSTR(copy, "  ")
            WEND
        END IF
    END IF
 
    REDIM Arr(1 TO 1) 'clear it
    curpos = 1
    arrpos = 1
    lc = LEN(copy)
    dpos = INSTR(curpos, copy, Delim)
    DO UNTIL dpos = 0
        Arr(arrpos) = MID$(copy, curpos, dpos - curpos)
        arrpos = arrpos + 1
        REDIM _PRESERVE Arr(1 TO arrpos + 1) AS STRING
        curpos = dpos + LEN(Delim)
        dpos = INSTR(curpos, copy, Delim)
    LOOP
    Arr(arrpos) = MID$(copy, curpos)
    REDIM _PRESERVE Arr(1 TO arrpos) AS STRING
END SUB
 
'for eval
SUB arrSubst (a() AS STRING, substLow AS LONG, substHigh AS LONG, subst AS STRING)
    DIM i AS LONG, index AS LONG
    a(substLow) = subst: index = substLow + 1
    FOR i = substHigh + 1 TO UBOUND(a)
        a(index) = a(i): index = index + 1
    NEXT
    REDIM _PRESERVE a(LBOUND(a) TO UBOUND(a) + substLow - substHigh)
END SUB
 
'for eval
FUNCTION find% (a() AS STRING, s$)
    DIM i%
    FOR i% = LBOUND(a) TO UBOUND(a)
        IF a(i%) = s$ THEN find% = i%: EXIT FUNCTION
    NEXT
END FUNCTION
 
'ltrim a number float  for eval double to string
FUNCTION ls$ (n AS _FLOAT)
    ls$ = LTRIM$(STR$(n))
END FUNCTION
 
 

bplus · « **Reply #4 on:** February 22, 2021, 02:24:10 pm »

Now can we get String functions into this? No probably NOT.

That hypothesis made, let me or someone else defeat it!

String functions have to be handled first with all the spaces and other parsing delimiters that they may contain.

Only want to forbid one char ; semi-colon from strings for arguments delimiter, this is after some:
var $= argsList$

var = no spaces inside when trimmed

space $= space is first parser to variable Name on left argList$ on right containing its future assigned value
this would distinguish from command for numeric space = space for var = evaluate$(this expression on the right)

argList$ split by ; is 2nd parsing into a(1 to n) arg strings$

eh maybe too simple to split by ; except works great in SB1 Interpreter. But if want to have functions inside functions parsing by anything is going to split it up wrongly, so the argList$ is going to have to be analysed like evaluate 2nd part does by searching for deepest level () doing that and working up until no () left. Only not parenthesis since numeric evaluate uses that, maybe [ ] or {}'s...

Could do it like Python with no endings first in left is last processed, first processed is farthest right
FILO First in, Last Out
that would be like a stack too.

var $= funN(... ; (funN-1(... ; ( funN-2(... ; ...; fun1(literal or var)

I swear we are on the edge of magic with the task of demystifying it.

bplus · « **Reply #5 on:** March 02, 2021, 03:09:34 pm »

what do you think qm.

should we shake things up a bit by changing all symbols that require two hands to type to one-handed ones.
ok to use more than a single letter, i see, because ops list has 'and' and 'not'.

can it be done qm.

Yes but the problem is going to be variable names conflicting with operator names. Using symbols prevents such accidental name / value substitutions.

Solution options?

+ Force variable declarations by starting all of them with a v for variable, in fact this may be a way to allow spaces in variable names? Start with v end with z, sounds like more typing not less.

+ Force dot or / before operators so they are recognized as such. Nope. No way!

v starts a one word variable name a space ends it. Actually that might help process a code line.

Nah I am not messing with the right side of =.

bplus · « **Reply #6 on:** March 03, 2021, 10:24:53 am »

Quote

Yes but the problem is going to be variable names conflicting with operator names. Using symbols prevents such accidental name / value substitutions.

Maybe not, depends what level the subst's take place, usually way before eval is called so its all numbers and some function names. The function names all end with ( Open Patrenthesis or op for short or one handed typists.

a for add
s for subtract
m for mult
d for divide
r for modlulus AKA Remainder
p for power

1 a 1 = 2
2 m 12 = 24
-3 d -4 = .75
17 r 5 = 2
I can do it so a cinch for computer.

Yes for SB3 after SB2 super Eval working.

Still conflict with variables one letter long so short hand goal conflicts with one handed typing goal.

News:

Author Topic: EVAL Function (Read 4319 times)

bplus

EVAL Function

SMcNeill

Re: EVAL Function - NOT Boolean evaluation is fixed

bplus

Re: EVAL Function - NOT Boolean evaluation is fixed

bplus

Re: EVAL Function - NOT Boolean evaluation is fixed

bplus

Re: EVAL Function - NOT Boolean evaluation is fixed

bplus

Re: EVAL Function

bplus

Re: EVAL Function