﻿ Building EVAL function step by step

 Building EVAL function step by step
07-13-2017, 11:32 AM (This post was last modified: 07-13-2017 11:53 AM by bplus.)
Post: #11
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
OK with this step you may see better why I place such a high value on the Word Tools.

I am sure they probably take more time to process, but for me, coding wise, they make things easy to follow, easy to code, get me from impossibly complicated to quite doable, thank you very much!

I hope you can see this also when you read over the code.
(code edited for typos)

Code Snippet: [Select]
```' EVAL recursive 4 parenthesis.bas for FB (B+=MGA) 2017-07-13 ' part 2 of step by step series ' ' Now we add the nested () handling. This is when EVAL needs to become recursive. ' Before EVAL  begins work on the binary opertors it will check if any ( are present ' in the evaluation expression string. If so, it will find it's corresponding ) at the same ' nested level and isolate the inner section for processing and if it finds another ( ' in the string it will likewise process the inside of that before the outer ' set, and so on...  until gets to inner most () set then it will finsih that, then ' finish the next up and so on until one value remains (hopefully). ' ' I will also leave in all the numeric operators ^ and % with 4 main arithmetic +-*/ ' 'screen setup Const XMAX = 1200 Const YMAX = 720 ScreenRes XMAX, YMAX Width XMAX\8, YMAX\16      ' Use 8*16 font ' Declare Function Evaluate(e As String) As Double Declare Function evalW(s As String) As Double ' ' Word Tools Declare Function wPrep(s As String) As String Declare Function Wrd(s As String, wNumber As Integer)  As String Declare Function wCnt(s As String) As Integer Declare Function wIn(s As String, Wrd As  String) As Integer Declare Function wSubst(s As String, first As Integer, last As Integer ,subst As String) As String ' Common Shared As String EvalErr  'store error messages here ' Dim As String e Dim As Double r ' '  tests e = "2*-3 - -4+-0.25" ' returns -2.25 OK but must  isolate - meant for subtraction e = "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10" ' returns 71 OK 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 e = "(1.4 + 2^(19%4))/2"        ' > 4.7 OK e = ".3 + 2*10^-8" ' 'IMPORTANT NOTE: wrap - sign with spaces if meant for subtraction, 'if meant to signal neg number leave no space between it and number ' ? "The following is the test string for evaluation:" Print e r = Evaluate(e) If EvalErr <> "" Then Print "Error: ";EvalErr Else Print "Expression = ";r ? "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 As String) As Double  Dim As String c, b, subst  Dim As Integer i, po, p            ' po ( parenthesis open) will be used to test the balance of () pairs  ' whenever po falls below 0 then too many  ) to how many  ( started  ' when through whole string po if balanced = 0 otherwise error!            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(" -.0123456789", c) > 0 Then    b = b + c   EndIf    If po < 0 Then EvalErr = "Too many )" : Exit Function    Next  If po <> 0 Then EvalErr = "Unbalanced ()" : Exit Function  e = wPrep(b)  Evaluate = evalW(e) End Function ' ' the recursive part of EVAL Function evalW(s As String) As Double  Dim As Integer pop, lPlace, i, rPlace, wc, po, recurs, p, o  Dim As String w, inner, ops, op, middle  Dim As Double a, b, innerV    ? "EvalW gets: ";s  'using word tool wIn to get location of ( in expression string  pop = wIn(s, "(")   'parenthesis open place, start position of ( in evaluation string  While pop > 0        ' while we have ( in string   lPlace = pop    ' lPlace is distinguished later from pop when functions are added   wc = wCnt(s) : po = 1   For i = pop + 1 To wc    ' now we are looking for the ) that goes with ( at pop or lPlace    If Wrd(s, i) = "(" Then po = po + 1   'one level down further    If Wrd(s, i) = ")" Then po = po - 1    'one level back up    If po = 0 Then rPlace = i : Exit For  'same level as start (,  there it is!   Next   inner = ""  'now get the contents between the (), build the inner string, word tools make it easy!   For i = (pop + 1) To (rPlace - 1)    w = Wrd(s, i)    inner = inner + w + " "    If wIn("( + - * / % ^", w) > 0 Then recurs = 1  'flag to call this function = recursively   Next   If recurs Then innerV = evalW(inner) Else innerV = Val(inner)   s = wSubst(s, lPlace, rPlace, Str(innerV))  'this uses another word tool to replace a section with a value   pop = wIn(s, "(")  'get the next parenthesis open from new s string  Wend '   ops = "% ^ / * - +"   'all () cleared, now for binary ops  For o = 1 To 6   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 = 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 = 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 = Str(a / b)      Else       EvalErr = "Div by 0"       Exit Function      End If     Case "*" : middle = Str(a * b)     Case "-" : middle = Str(a - b)     Case "+" : middle = Str(a + b)    End Select    s = wSubst(s, p - 1, p + 1, middle)    p = wIn(s, op)   Wend  Next  evalW = Val(s) End Function ' 'return trimmed  source string s with one space between each word  Function  wPrep(s As String) As String    Dim p As Integer    s = Trim(s)    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(s As String, wNumber As Integer)  As String  Dim As String w    Dim As Integer i, c    's = wPrep(s)  If Len(s) = 0 Then Return ""   w = "" : c = 1    For i = 1 To Len(s)     If Mid(s, i, 1) = " " Then          If c = wNumber Then Return w          w = "" : c += 1     Else          w = w + Mid(s, i, 1)     End If    Next    If c <> wNumber Then Return " " Else Return w End Function ' 'This function counts the words in source string s 'this function assumes s has been thru wPrep  Function  wCnt(s As String) As Integer   Dim As Integer c, p, ip   's = wPrep(s)    If Len(s) = 0 Then wCnt = 0 : Exit Function    c = 1 : p = 1 : ip = InStr(p, s, " ")    While ip       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 As String, wd As  String) As Integer    Dim As Integer wc, i    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 As String, first As Integer, last As Integer ,subst As String) As String   Dim As Integer wc, i, subF   Dim b As String    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 = trim(b)  End Function```

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
07-13-2017, 06:05 PM
Post: #12
(Print Post)
 Aurel Member Posts: 275 Likes Given: 26 Likes Received: 46 in 42 posts Joined: Apr 2017 Country of Origin::
Hi Mark
I like to see your way..

Ed
As i suspect main differnece between them is in using some sort of stack
as i try to explain in first post in PCP topic

basicPro forum:
http://basicpro.mipropia.com/smf/index.php
AurelSoft main site:
http://aurelsoft.ucoz.com
07-16-2017, 02:52 PM
Post: #13
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
The next step adds functions to EVAL and also I added 2 constants pi and e and one variable x for which a value must be named before evaluate is called PLUS more Binary operators for comparisons. The code is already here:
http://www.thejoyfulprogrammer.com/qb64/...4280905334

And the step after is also in that thread, adding AND, OR and NOT in EVAL 2.bas code.

So thanks for your patience and attention.