Hello everyone, I always follow you and continue to appreciate the project and everyone's effort to improve and keep our beloved QB64 alive! I’m sharing with you a code that I thought of and partially developed (and obviously then refined with the help of AI) to interpret a string with a calculation expression, just like scientific calculators do with expressions. I believe it is useful and I hope it helps someone. If you test the code, everything will be clearer. Pass to the function - in the example, this first function is not there because the expression is in the main code - something like: a# = calc# ("1 + (variable#(73) ^ 2 + (variable#(74) + variable#(88) / 100) ) * 100") where variable#() are obviously the variables to be processed. Feel free to modify the expression by adding and removing operators, and you will (always?) get the correct result.
Let me know! Maybe something like this already exists and I just don't know about it yet, or perhaps it's not as useful as it seems to me.
Congratulations you are on your way to building an expression evaluator, a milestone in coding!
You have a glimpse
Here's mine from 2018, huh! I had one in FB???
Code: (Select All)
_Title "Eval by bplus translated from FB 2018-02-05"
' from: EVAL 2 bplus.bas for FB (B+=MGA) 2017-07-04
'based on successful: evalW 2.txt for JB [B+=MGA] 2017-03-11 repost with edits
' EVAL 1 - Just Basic Eval code translated and = > < >= <= <> binary's added
'EVAL 2 - add And and Or, Not
' tests
e$ = "log(0)" 'err
e$ = "exp(-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
e$ = "2*-3 - -4+-0.25" ' returns -2.25 OK but must isolate - meant for subtraction OK
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(sin(30)/cos(30))" ' > 30 with DFlag = 1
e$ = ".3 + 2*10^-8"
e$ = "pi/6 < pi" 'yeah my first Boolean!
e$ = "99 % 11 = 0"
e$ = "23 <= 22"
e$ = "(99 % 9 = 0) and (not 23 < 22 or 5 < 3)"
'IMPORTANT NOTE: wrap - sign with spaces if meant for subtraction,
'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 number if no error.
Function Evaluate (e$)
'Dim As String c, b, subst
'Dim As Integer i, po, p
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 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
e$ = wPrep(b$)
For i = 1 To 3
p = wIn(e$, Wrd$("x e pi", i))
While p > 0
Select Case i
Case 1: subst$ = LTrim$(Str$(GlobalX)) ': PRINT "subst "; subst$, GlobalX
Case 2: subst$ = LTrim$(Str$(Exp(1)))
Case 3: subst$ = LTrim$(Str$(_Pi))
End Select
e$ = wSubst$(e$, p, p, subst$)
p = wIn(e$, Wrd("x e pi", i))
Wend
Next
Evaluate = evalW(e$)
End Function
' the recursive part of EVAL
Function evalW (s$)
Dim pop As Integer, lPlace As Integer, i As Integer, rPlace As Integer, wc As Integer
Dim po As Integer, funPlace As Integer, recurs As Integer, p As Integer, o As Integer
'Dim As String fun, w, test, inner, ops, op, middle
'Dim As Double a, b, innerV, m
Print "EvalW gets: "; s$ 'debug or fun$ to watch recursive calls in reverse
pop = wIn(s$, "(") 'parenthesis open place
While pop > 0
If pop = 1 Then
fun$ = "": lPlace = 1
Else
test$ = Wrd$(s$, pop - 1)
funPlace = wIn("sin cos tan atan log exp sqr rad deg", test$) 'no asin or acos in QB64
If funPlace > 0 Then
fun$ = test$: lPlace = pop - 1
Else
fun$ = "": lPlace = pop
End If
End If
wc = wCnt(s$): po = 1
For i = pop + 1 To wc
If Wrd$(s$, i) = "(" Then po = po + 1
If Wrd$(s$, i) = ")" Then po = po - 1
If po = 0 Then rPlace = i: Exit For
Next
inner$ = ""
For i = (pop + 1) To (rPlace - 1)
w$ = Wrd$(s$, i)
inner$ = inner$ + w$ + " "
If wIn("( and or = < > <= >= <> + - * / % ^", w$) > 0 Then recurs = 1
Next
If recurs Then innerV = evalW(inner$) Else innerV = Val(inner$)
Select Case fun$
Case "": m = innerV
Case "sin": If DFlag Then m = Sin(RAD * innerV) Else m = Sin(innerV)
Case "cos": If DFlag Then m = Cos(RAD * innerV) Else m = Cos(innerV)
Case "tan": If DFlag Then m = Tan(RAD * innerV) Else m = Tan(innerV)
'CASE "asin": IF DFlag THEN m = DEG * (Asin(innerV)) ELSE m = Asin(innerV)
' CASE "acos": IF DFlag THEN m = DEG * (acos(innerV)) ELSE m = acos(innerV)
Case "atan": If DFlag Then m = DEG * (Atn(innerV)) Else m = Atn(innerV)
Case "log"
If innerV > 0 Then
m = Log(innerV)
Else
EvalErr$ = "LOG only works on numbers > 0.": Exit Function
End If
Case "exp" 'the error limit is inconsistent in JB
If -745 <= innerV And innerV <= 709 Then 'your system may have different results
m = Exp(innerV)
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 innerV >= 0 Then
m = Sqr(innerV)
Else
EvalErr$ = "SQR only works for numbers >= 0.": Exit Function
End If
Case "rad": m = innerV * RAD
Case "deg": m = innerV * DEG
Case Else: EvalErr$ = "Unidentified function " + fun$: Exit Function
End Select
s$ = wSubst(s$, lPlace, rPlace, LTrim$(Str$(m)))
pop = wIn(s$, "(")
Wend
ops$ = "% ^ / * - + = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
For o = 1 To 15
op$ = Wrd$(ops$, o)
p = wIn(s$, op$)
While p > 0
a = Val(Wrd$(s$, p - 1))
b = Val(Wrd$(s$, p + 1))
Select Case op$
Case "%"
If b >= 2 Then
middle$ = LTrim$(Str$(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
middle$ = LTrim$(Str$(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
middle$ = LTrim$(Str$(a / b))
Else
EvalErr$ = "Div by 0"
Exit Function
End If
Case "*": middle$ = LTrim$(Str$(a * b))
Case "-": middle$ = LTrim$(Str$(a - b))
Case "+": middle$ = LTrim$(Str$(a + b))
Case "=": If a = b Then middle$ = "1" Else middle$ = "0"
Case "<": If a < b Then middle$ = "1" Else middle$ = "0"
Case ">": If a > b Then middle$ = "1" Else middle$ = "0"
Case "<=": If a <= b Then middle$ = "1" Else middle$ = "0"
Case ">=": If a >= b Then middle$ = "1" Else middle$ = "0"
Case "<>": If a <> b Then middle$ = "1" Else middle$ = "0"
Case "and": If a <> 0 And b <> 0 Then middle$ = "1" Else middle$ = "0"
Case "or": If a <> 0 Or b <> 0 Then middle$ = "1" Else middle$ = "0"
Case "not": If b = 0 Then middle$ = "1" Else middle$ = "0" 'use b as nothing should be left of not
End Select
s$ = wSubst$(s$, p - 1, p + 1, middle$)
'PRINT s$
p = wIn(s$, op$)
Wend
Next
evalW = Val(s$)
'PRINT evalW
End Function
'return trimmed source string s with one space between each word
Function wPrep$ (ss$)
s$ = LTrim$(RTrim$(ss$))
If Len(s$) = 0 Then wPrep$ = "": Exit Function
'remove all double or more spaces
p = InStr(s$, " ")
While p > 0
s$ = Mid$(s$, 1, p) + Mid$(s$, p + 2, Len(s$) - p - 1)
p = InStr(s$, " ")
Wend
wPrep$ = s$
End Function
' This duplicates JB word(string, wordNumber) base 1, space as default delimiter
' by returning the Nth word of source string s
' this function assumes s has been through wPrep
Function Wrd$ (ss$, wNumber)
's$ = wPrep(ss$)
s$ = ss$ 'don't change ss$
If Len(s$) = 0 Then Wrd$ = "": Exit Function
w$ = "": c = 1
For i = 1 To Len(s$)
If Mid$(s$, i, 1) = " " Then
If c = wNumber Then Wrd$ = w$: Exit Function
w$ = "": c = c + 1
Else
w$ = w$ + Mid$(s$, i, 1)
End If
Next
If c <> wNumber Then Wrd$ = " " Else Wrd$ = w$
End Function
'This function counts the words in source string s
'this function assumes s has been thru wPrep
Function wCnt (s$)
Dim c As Integer, p As Integer, ip As Integer
's = wPrep(s)
If Len(s$) = 0 Then wCnt = 0: Exit Function
c = 1: p = 1: ip = InStr(p, s$, " ")
While ip
c = c + 1: p = ip + 1: ip = InStr(p, s$, " ")
Wend
wCnt = c
End Function
'Where is word In source s, 0 = Not In source
'this function assumes s has been thru wPrep
Function wIn (s$, wd$)
Dim wc As Integer, i As Integer
wc = wCnt(s$): wIn = 0
For i = 1 To wc
If Wrd$(s$, i) = wd$ Then wIn = i: Exit Function
Next
End Function
' substitute string in s to replace section first to last words inclusive
'this function assumes s has been thru wPrep
Function wSubst$ (s$, first, last, subst$)
Dim wc As Integer, i As Integer, subF As Integer
wc = wCnt(s$): b$ = ""
For i = 1 To wc
If first <= i And i <= last Then 'do this only once!
If subF = 0 Then b$ = b$ + subst$ + " ": subF = 1
Else
b$ = b$ + Wrd$(s$, i) + " "
End If
Next
wSubst$ = LTrim$(RTrim$(b$))
End Function
Dang it was <300 LOC but yeah, no string functions, that was later with Fval.
The first question, when trying to solve a problem, is: 'Is there a solution that someone has already found?'
Usually, the answer is yes: someone, somewhere, has already solved the problem. Someone has already thought about it, that's practically certain!
Then comes the second problem: where??
In the end, you try to do it on your own...
Anyway, that's part of the fun: finding solutions!
My code is tailored to the problem I have in the project I'm developing, while yours is really more complete and versatile. I think I will copy something...
'Steve Subs/Functins for _MATH support with CONST FunctionEvaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it PreParse t$
'Deal with brackets first
exp$ = "(" + t$ + ")"'Starting and finishing brackets for our parse routine.
Do
Eval_E = InStr(exp$, ")") If Eval_E > 0Then
c = 0 Do Until Eval_E - c <= 0
c = c + 1 If Eval_E Then IfMid$(exp$, Eval_E - c, 1) = "("ThenExit Do End If Loop
s = Eval_E - c + 1 If s < 1ThenEvaluate_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.
SubParseExpression (exp$) Dim num(10) AsString 'PRINT exp$
exp$ = DWD(exp$) 'We should now have an expression with no () to deal with
For J = 1To250
lowest = 0 Do Until lowest = Len(exp$)
lowest = Len(exp$): OpOn = 0 For P = 1ToUBound(OName) 'Look for first valid operator If J = PL(P) Then'Priority levels match IfLeft$(exp$, 1) = "-"Then startAt = 2Else startAt = 1
op = InStr(startAt, exp$, OName(P)) If op = 0AndLeft$(OName(P), 1) = "_"And qb64prefix_set = 1Then 'try again without prefix
op = InStr(startAt, exp$, Mid$(OName(P), 2)) If op > 0Then
exp$ = Left$(exp$, op - 1) + "_" + Mid$(exp$, op)
lowest = lowest + 1 End If End If If op > 0And op < lowest Then lowest = op: OpOn = P End If Next If OpOn = 0ThenExit Do'We haven't gotten to the proper PL for this OP to be processed yet. IfLeft$(exp$, 1) = "-"Then startAt = 2Else startAt = 1
op = InStr(startAt, exp$, OName(OpOn))
numset = 0
'*** SPECIAL OPERATION RULESETS If OName(OpOn) = "-"Then'check for BOOLEAN operators before the - Select CaseMid$(exp$, op - 3, 3) Case"NOT", "XOR", "AND", "EQV", "IMP" Exit Do'Not an operator, it's a negative End Select IfMid$(exp$, op - 3, 2) = "OR"ThenExit Do'Not an operator, it's a negative End If
If op Then
c = Len(OName(OpOn)) - 1 Do Select CaseMid$(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 ThenExit 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 CaseMid$(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 CaseMid$(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 ThenExit 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 IfMid$(num(1), 1, 1) = "N"ThenMid$(num(1), 1) = "-" IfMid$(num(2), 1, 1) = "N"ThenMid$(num(2), 1) = "-" If num(1) = "-"Then
num(3) = "N" + EvaluateNumbers(OpOn, num()) Else
num(3) = EvaluateNumbers(OpOn, num()) End If IfMid$(num(3), 1, 1) = "-"ThenMid$(num(3), 1) = "N" IfLeft$(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
SubSet_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) AsString, PL(10000) AsInteger '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) = "C_RG": PL(i) = 10'_RGB32 converted
i = i + 1: OName(i) = "C_RA": PL(i) = 10'_RGBA32 converted
i = i + 1: OName(i) = "_RGBA": PL(i) = 10
i = i + 1: OName(i) = "_RGB": 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
IfInStr(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", "_BLUE", "C_BL", "_ALPHA" Case Else
C$ = Mid$(num(2), l2)
num(2) = Left$(num(2), l2 - 1) End Select End If
'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 = 1ToUBound(OName) IfMid$(t$, e, Len(OName(i))) = OName(i) And PL(i) > 1And PL(i) <= 250Then good = -1: Exit For'We found an operator after our ), and it's not a CONST (like PI) Next IfNot 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 = 1ToLen(bin$) IfMid$(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
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 = 0Or (InStr(l + 1, t$, "OR") > 0AndInStr(l + 1, t$, "OR") < l1) Then l1 = InStr(l + 1, t$, "OR") If l1 = 0Or (InStr(l + 1, t$, "XOR") > 0AndInStr(l + 1, t$, "XOR") < l1) Then l1 = InStr(l + 1, t$, "XOR") If l1 = 0Or (InStr(l + 1, t$, "EQV") > 0AndInStr(l + 1, t$, "EQV") < l1) Then l1 = InStr(l + 1, t$, "EQV") If l1 = 0Or (InStr(l + 1, t$, "IMP") > 0AndInStr(l + 1, t$, "IMP") < l1) Then l1 = InStr(l + 1, t$, "IMP") If l1 = 0Then 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
l = 0 Do
l = InStr(l + 1, t$, PP_TypeMod(j)) If l = 0ThenExit Do
i = 0: l1 = 0: l2 = 0: lo = Len(PP_TypeMod(j)) Do If PL(i) > 10Then
l2 = _InStrRev(l, t$, OName$(i)) If l2 > 0And 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 > 15Then
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 > 0And l > 2Then'Don't check the starting bracket; there's nothing before it.
good = 0 For i = 1ToUBound(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 IfLeft$(OName(i), 1) = "_"And qb64prefix_set = 1Then '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 IfNot 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 > 0And l < Len(t$) Then
good = 0 For i = 1ToUBound(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 IfLeft$(OName(i), 1) = "_"And qb64prefix_set = 1Then '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 IfMid$(t$, l + 1, 1) = ")"Then good = -1 IfNot good Then e$ = "ERROR - Improper operations after ).": Exit Sub
l = l + 1 End If Loop Until l = 0Or l = Len(t$) 'last symbol is a bracket
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 < 1Or check1 > 1ThenN2S = exp$: Exit Function'If no scientic notation is found, or if we find more than 1 type, it's not SN!
03-28-2025, 10:04 AM (This post was last modified: 03-28-2025, 10:05 AM by bplus.)
(03-27-2025, 09:07 AM)krovit Wrote: The first question, when trying to solve a problem, is: 'Is there a solution that someone has already found?'
Usually, the answer is yes: someone, somewhere, has already solved the problem. Someone has already thought about it, that's practically certain!
Then comes the second problem: where??
In the end, you try to do it on your own...
Anyway, that's part of the fun: finding solutions!
My code is tailored to the problem I have in the project I'm developing, while yours is really more complete and versatile. I think I will copy something...
True about someone else already doing it! I've even found words I made up already taken in Google search!
Where is solution? Good question because people use different terms for things ie MS Help never works for me because my terms for things never match the technical names and of course "thingy" is too ambiguous
Alsolutely right! the fun part is finding solutions on your own
@krovit, I am curious the problem that lead you to your "evaluator" function?
For me, it's useful for formula's input by user of app and/or plotting a function.
Say you want a temperature conversion or yards to meters... or plot or sin waves.
03-29-2025, 05:47 PM (This post was last modified: 03-29-2025, 05:51 PM by krovit.)
(03-28-2025, 10:04 AM)bplus Wrote:
(03-27-2025, 09:07 AM)krovit Wrote: The first question, when trying to solve a problem, is: 'Is there a solution that someone has already found?'
Usually, the answer is yes: someone, somewhere, has already solved the problem. Someone has already thought about it, that's practically certain!
Then comes the second problem: where??
In the end, you try to do it on your own...
Anyway, that's part of the fun: finding solutions!
My code is tailored to the problem I have in the project I'm developing, while yours is really more complete and versatile. I think I will copy something...
True about someone else already doing it! I've even found words I made up already taken in Google search!
Where is solution? Good question because people use different terms for things ie MS Help never works for me because my terms for things never match the technical names and of course "thingy" is too ambiguous
Alsolutely right! the fun part is finding solutions on your own
@krovit, I am curious the problem that lead you to your "evaluator" function?
For me, it's useful for formula's input by user of app and/or plotting a function.
Say you want a temperature conversion or yards to meters... or plot or sin waves.
I wrote a code that, in some way, self-generates (it's not much, but it does).
It is a system that creates input masks with various types of fields.
My goal is to structure a system that can be easily adapted to (almost) any management problem.
There are many variables, and one of my fixations is the parameterization and simplification of the code because it is all too easy to get lost in thousands of lines of code. For this reason, I write, at a certain point, I would like to write certain operations in a nearly natural way and then let the code transform it by inserting all the keywords and the right references.
It is easier to write
"(1 + v65 / 1000) * v75^2 / v88"
than
j# = 1 + val(_trim$(str$(variabile$(65))) + / 1000) * val(_trim$(str$(variabile$(75))^2 / val(_trim$(str$(variabile$(88))
Consider modifying a line like this without losing your mind is not easy, and there is already an error in the example with the parentheses that I can't see. Imagine if I have to modify or continuously implement it, perhaps after having forgotten how I reasoned to write it in the first place.
And things are much more complex than I present them.
I have always believed that software should solve problems and simplify life. One cannot expect everything from QB64, but on the other hand, I don't like to rely blindly on closed systems: there's no fun in that!
Let's say that QB64 is the tool of a craftsman from another time...
