You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


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)
RE: Building EVAL function step by step
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

B += _
Find all posts by this user
Like Post
07-13-2017, 06:05 PM
Post: #12
 (Print Post)
RE: Building EVAL function step by step
Hi Mark
dont worry nobody will kill your thread about your method in EVAL
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
EU Radioboard forum:
http://euradioboard.createmybb3.com/index.php
AurelSoft main site:
http://aurelsoft.ucoz.com
Find all posts by this user
Like Post
07-16-2017, 02:52 PM
Post: #13
 (Print Post)
RE: Building EVAL function step by step
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.

B += _
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Touche
QB64 Member Project - Pivot version two
QB64 Member Project - Isolation
QB64 Member Project - Inside Moves
QB64 Member Project - Rotating Background
QB64 Member Project - Input
QB64 Member Project - Kings Court
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Line Thickness
QB64 Member Project - OpenGL Triangles
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Rubix's Magic
QB64 Member Project - Color Rotating Text
QB64 Member Project - Color Triangles
QB64 Member Project - Domain
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Algeria Weather
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Score 4
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Basic Dithering
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Kings Valley verion one
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Sabotage
QB64 Member Project - Qubic
QB64 Member Project - Othello
QB64 Member Project - Splatter
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Point Blank
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Dreamy Clock
QB64 Member Project - Blokus
QB64 Member Project - Overboard
QB64 Member Project - Quarto
QB64 Member Project - 9 Board
QB64 Member Project - Pivet version one
QB64 Member Project - Amazon
QB64 Member Project - Foursight
QB64 Member Project - Bowditch curve
QB64 Member Project - Connect Four
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Exit
QB64 Member Project - Dakapo
QB64 Member Project - Spiro Roses
QB64 Member Project - Swirl
QB64 Member Project - ARB Checkers