EVAL

New to FreeBASIC? Post your questions here.
St_W
Posts: 1626
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: EVAL

Post by St_W »

bplus wrote:I imagine FB itself has something like an EVAL function built into it. Is it built from FB or some other language?
The FreeBasic compiler (fbc) has not all parts needed for an interpreter, but you are right, it also needs a parser for FreeBasic code. However, I doubt that you could re-use the parsing code from fbc easily. Additionally you would still have to implement the interpreting functionality of the AST (Abstract Syntax Tree), which is the result of parsing.
As I mentioned previously the complexity of an expression evaluator depends on the features it shall support. Basic math is not that hard, but if you want to have somewhat near a FreeBasic interpreter it will get very complex. So I'd first think about what you'll really need or want. Depending on that I'd choose whether FB is suitable for the task or not.

Some (high-level, simplified) overview compiler vs. interpreter:
Compiler: BAS --[lexer]--> tokens --[parser]--> AST --[transform]--> IR --[emit]--> assembly/C --[assemble]--> machine code
Interpreter:BAS --[lexer]--> tokens --[parser]--> AST --[transform]--> IR --[interpret]-->
(IR ... intermediate representation, which may be in a different format for compiler/interpreter.)
BasicCoder2
Posts: 3908
Joined: Jan 01, 2009 7:03
Location: Australia

Re: EVAL

Post by BasicCoder2 »

I was unaware of D.J.Peters evaluator.
Back in ye old days I remember I had the source code for a full blown evaluator, sadly no longer, it was part of the BASIC interpreter source code that came with the computer. Back in those days there was not much memory so I assume it was efficient. It was also probably written in assembler source code. I was into writing all my stuff in assembler back in those days for speed reasons.
The FreeBasic compiler must have one tucked away some where.
Do you need to include variables?
eg. A+B/C
I remember implementing that also. A simple matter of recognizing a variable label and looking up its stored value to push on the stack.
And there are the string functions.
dim as integer a
dim as string myString
a = len("hello")
s = mid(myString,4,2)
marcov
Posts: 3462
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Re: EVAL

Post by marcov »

The trick is all parsing is done inside the compiler. The compiled result (the program that is executed) does not contain string based sourcecode OR variablenames (all variable names have been transformed to memory locations or offsets to memory locations (e.g. record field relative to begin of the record).

So if you want interpreter functionality you need to build an interpreter inside your compiled program. Want to call functions ? Add functions to that interpreter's parser and in the implementation of the interpreter (or its VM) call the FB functions.

Want to access variables? No easy solution. Either give all variables to the interpreter before you run it (e.g. series of .setsingle('varname',valueofvarname); ) or let the interpreter call a function you provide with a stringname, and the user has to implement it to return values for every variable name (and maybe if it is cacheable)

There are some hacks possible (e.g. trawl debug information to find variable locations) but this is not easy (name mangling, varying debug formats per platform), and not everybody wants to distribute binaries with debuginfo.

Basically, if you want it all? Use an interpreted Basic, you are on the wrong track with a compiler.

If you only want an subset (get a value for an expression with a few symbols in it), implement a limit evaluator/interpreter for it.
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: EVAL

Post by owen »

FbCadCam -Macro Expression Evaluator : see attachment

I have commented out small sections of the 1200 or so LOC that are used to get the values of variables used in an expression such as would be the case in the following expresson:
a+b*c
atan2((r2h/2),Sqr((r1h/2)^2 + (r2x2-r1cx)^2 - (r2h/2)^2)) / rad

So no variables are interpreted or can be used in this example. Instead it will only handle expressions with numerics, i.e.:
1+2*3
atan2((100/2),Sqr((100/2)^2 + (300-1)^2 - (50/2)^2)) / .017444

see attachment @
http://www.thejoyfulprogrammer.com/qb64 ... 1308760250
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: EVAL

Post by bplus »

Thanks Owen, dang how'd I miss that?

There was a question about running variables with EVAL. For me, I plugged their values into the expression string before running it through the EVAL function as part of the evaluation string prep routine.

There was mention of limiting EVAL, yeah forget about strings! (for getting started anyway) First the maths, then pickup Booleans == <> <= > ... needed for decision branching then AND and OR. I read at the QB64 forum that NOT was real headache. I remember having a heck of a time deciding a - sign as part of a number or as a subtraction signal. That too became part of the evaluation string prep.

Tonight I just revised all my Word String tools in SmallBASIC for what I call Just In Time parsing that should now be easier for me to translate to FB. It is based on JB's WORD$() function an asset that easily makes a string array-like but much more dynamic than JB arrays.
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: EVAL

Post by owen »

handling boolean is not part of expression evaluation in my example. in fbcacam-macro.bas it is done in another function when encountered in if thens and do while and select case situations. the function is called evalute_condition i think
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: EVAL

Post by owen »

i probably misspoke. handling booleans...
i think the expresion evaluator does do x=1 and 1.

strings, i havent implimented yet and not sure i will. not sure if i can affford to loose anu more hair.

sorry i just ran out time. got to drive from DE to OH tonight.
aurelVZAB
Posts: 667
Joined: Jul 02, 2008 14:55
Contact:

Re: EVAL

Post by aurelVZAB »

I am wondering
why DJPeters solver not work ?
I really looking simple and clear...
anyone have fixed version?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: EVAL

Post by D.J.Peters »

aurelVZAB wrote:I am wondering why DJPeters solver not work ?
I tested it sucessfull here, what are the problem on your box ?

Joshy

file: fbEval.bas

Code: Select all

' simple expression solver
declare sub Unary        (byref Result as double)
declare sub Parenthesized(byref Result as double)
declare sub Exponent     (byref Result as double)
declare sub MulDiv       (byref Result as double)
declare sub AddSub       (byref result as double)
declare sub DoUnary      (Op as string,byref Result as double)
declare sub GetToken

enum TokenTypes
  EOL
  DELIMETER
  NUMBER
  IDENT
end enum

dim shared as string  Expression,Token,char
dim shared as integer TokenType,cPos

sub sError(sErr as string)
  print "Error: " & sErr
  beep:sleep:end
end sub

function IsDigit() as integer
  dim as integer c = asc(char)
  return ((c>47) and (c<58))
end function

function IsAlpha() as integer
  dim as integer c = asc(ucase(char))
  return ((c>64) and (c<91))
end function

function IsWhite() as integer
  dim as integer c = asc(char)
  return ((c=32) or (c=9))
end function

function IsDelimeter() as integer
  dim as integer c = asc(char)
  if c=9 then return 1
  return (instr("-+/*^()",char)>0)
end function

function IsFunction() as integer
  return (instr("ABS,ATN,COS,EXP,FAC,FIX,INT,LOG,RND,SGN,SIN,SQR,TAN",Token)>0)
end function

sub GetChar
  cPos+=1
  if cPos>len(Expression) then
    char="":return
  end if
  char=mid(Expression,cPos,1)
end sub

sub GetToken()
  GetChar
  if Char="" then
    Token     = ""
    TokenType = EOL
    return
  end if

  if IsDelimeter() then
    Token     = Char
    TokenType = DELIMETER
    return
  end if

  if IsDigit() then
    Token = ""
    while IsDelimeter()=0 and Char<>""
      Token=Token+Char
      GetChar
    wend
    TokenType = NUMBER
    cPos-=1
    return
  end if

  if IsAlpha() then
    Token = ""
    while IsAlpha() and Char<>""
      Token = Token + Char
      GetChar
    wend
    Token=ucase(Token)
    TokenType = IDENT
    cPos-=1
    return
  end if
end sub

sub AddSub(byref Result as double)
  dim as string Op
  dim as double Temp
  Unary(result)
  Op=Token
  while Op = "+" or Op = "-"
    GetToken()
    Unary(Temp)
    if Op="+" then
      Result+=Temp
    else
      Result-=Temp
    end if
    Op = Token
  wend
end sub

sub Unary(byref Result as double)
  dim as string Op
  if ( (TokenType=DELIMETER) and ((Token="+") orelse (Token="-")) ) then
    Op = Token
    GetToken()
  end if
  MulDiv(Result)
  if Op="-" then Result=-Result
end sub

sub MulDiv(byref Result as double)
  dim as string Op
  dim as double Temp
  Exponent(Result)
  Op=Token
  while (Op = "*") orelse (Op = "/")
    GetToken()
    Exponent(Temp)
    if (op="*") then
      Result *= Temp
    else
      if (Temp=0) then
        sError("div by zero")
      else
        Result /= Temp
      end if
    end if
    Op = Token
  wend
end sub

sub Exponent(byref Result as double)
  dim as double Temp
  Parenthesized(Result)
  if (Token="^") then
    GetToken()
    Parenthesized(Temp)
    Result ^= Temp
  end if
end sub

sub Parenthesized(byref Result as double)
  if (token = "-") orelse (token = "+") then Unary(Result)
  if (Token ="(") andalso (TokenType = DELIMETER) then
    GetToken()
    AddSub(Result)
    if (Token <> ")") then serror("unbalanced round brackets")
    GetToken()
  else
    select case TokenType
      case NUMBER
        Result = val(Token)
        GetToken
      case IDENT
        if IsFunction() then
          dim as string Func = Token
          dim as double res  = result
          GetToken
          Parenthesized(res)
          select case Func
          case "ABS": result = abs(res)
          case "ATN": result = atn(res)
          case "COS": result = cos(res)
          case "EXP": result = exp(res)
          case "FAC"
            if (Res<0) then
              sError("argument to factorial must be positive")
            else
              Result=1
              for i as integer =1 to Res
                Result*=i
              next
            end if
          case "FIX": result = fix(res)
          case "INT": result = int(res)
          case "LOG": result = log(res)
          case "RND": result = rnd(res)
          case "SGN": result = sgn(res)
          case "SIN": result = sin(res)
          case "SQR": result = sqr(abs(res))
          case "TAN": result = tan(res)
        end select
      else
        serror("unknow ident / function " & Token)
      end if
    end select
  end if
end sub

function Eval(e as string) as double
  dim as double result
  Expression=e 
  cPos=0
  GetToken()
  AddSub(result)
  return result
end function

dim as string e
e = "sqr(-atn(1)*4^(1+2+3))"
print e & " = " & Eval(e)
sleep
aurelVZAB
Posts: 667
Joined: Jul 02, 2008 14:55
Contact:

Re: EVAL

Post by aurelVZAB »

ok now work,,,
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: EVAL

Post by D.J.Peters »

aurelVZAB wrote:ok now work,,,
impossible for human ;-)
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: EVAL

Post by bplus »

Hello,

I have yet been able to get JD Peters EVAL to run. It seems to be stumbling over every little bit of space eg between the procedure name and (parameters listing), every space at start of line in procedures, an extra space here and there...

I am using Windows 10 laptop (64) with FbEdit default compiles. Is there a simple fix for this and others I may encounter?
Do I need to make a filter/converter? Ha, maybe get another browser!?

The program is a very nice size so I am curious to try it out.

PS never saw ENUM before!

APPEND 10:38 PM
OK finally got it working as this: (I am posting to test and see if my browser screws it up again)

Code: Select all

' simple expression solver
Declare Sub Unary(ByRef Result As Double)
Declare Sub Parenthesized(ByRef Result As Double)
Declare Sub Exponent(ByRef Result As Double)
Declare Sub MulDiv(ByRef Result As Double)
Declare Sub AddSub(ByRef result As Double)
Declare Sub DoUnary(Op As String,ByRef Result As Double)
Declare Sub GetToken

Enum TokenTypes
	EOL
	DELIMETER
	NUMBER
	IDENT
End Enum

Dim Shared As String Expression,Token, char
Dim Shared As Integer TokenType,cPos

Sub sError(sErr As String)
	Print "Error: " &sErr
	Beep:Sleep:End
End Sub

Function IsDigit() As Integer
	Dim As Integer c = Asc(char)
	Return ((c>47) And (c<58))
End Function

Function IsAlpha() As Integer
	Dim As Integer c = Asc(UCase(char))
	Return ((c>64) And (c<91))
End Function

Function IsWhite() As Integer
	Dim As Integer c = Asc(char)
	Return ((c=32) Or (c=9))
End Function

Function IsDelimeter() As Integer
	Dim As Integer c = Asc(char)
	If c=9 Then Return 1
	Return (InStr("-+/*^()",char)>0)
End Function

Function IsFunction() As Integer
	Return (InStr("ABS,ATN,COS,EXP,FAC,FIX,INT,LOG,RND,SGN,SIN,SQR,TAN",Token)>0)
End Function

Sub GetChar
	cPos+=1
	If cPos>Len(Expression) Then
		char="":Return
		End If
	char=Mid(Expression,cPos,1)
End Sub

Sub GetToken()
	GetChar
	If Char="" Then
		Token = ""
		TokenType = EOL
		Return
	End If
	If IsDelimeter() Then
		Token = Char
		TokenType = DELIMETER
		Return
	End If

	If IsDigit() Then
		Token = ""
		While IsDelimeter()=0 And Char<>""
			Token=Token+Char
			GetChar
		Wend
		TokenType = NUMBER
		cPos-=1
		Return
	End If

	If IsAlpha() Then
		Token = ""
		While IsAlpha() And Char<>""
			Token = Token + Char
			GetChar
		Wend
		Token=UCase(Token)
		TokenType = IDENT
		cPos-=1
		Return
	End If
End Sub

Sub AddSub(ByRef Result As Double)
	Dim As String Op
	Dim As Double Temp
	Unary(result)
	Op=Token
	While Op = "+" Or Op = "-"
		GetToken()
		Unary(Temp)
		If Op="+" Then
			Result+=Temp
		Else
			Result-=Temp
		End If
		Op = Token
	Wend
End Sub

Sub Unary(ByRef Result As Double)
	Dim As String Op
	If ( (TokenType=DELIMETER) And ((Token="+") OrElse (Token="-")) ) Then
		Op = Token
		GetToken()
	End If
	MulDiv(Result)
	If Op="-" Then Result=-Result
End Sub

Sub MulDiv(ByRef Result As Double)
	Dim As String Op
	Dim As Double Temp
	Exponent(Result)
	Op=Token
	While (Op = "*") OrElse (Op = "/")
		GetToken()
		Exponent(Temp)
		If (op="*") Then
			Result *= Temp
		Else
			If (Temp=0) Then
				sError("div by zero")
			Else
				Result /= Temp
			End If
		End If
		Op = Token
	Wend
End Sub

Sub Exponent(ByRef Result As Double)
	Dim As Double Temp
	Parenthesized(Result)
	If (Token="^") Then
		GetToken()
		Parenthesized(Temp)
		Result ^= Temp
	End If
End Sub

Sub Parenthesized(ByRef Result As Double)
	If (token = "-") OrElse (token = "+") Then Unary(Result)
	If (Token ="(") AndAlso (TokenType = DELIMETER) Then
		GetToken()
		AddSub(Result)
		If (Token <> ")") Then sError("unbalanced round brackets")
			GetToken()
		Else
			Select Case TokenType
				Case NUMBER
					Result = Val(Token)
					GetToken
				Case IDENT
					If IsFunction() Then
						Dim As String Func = Token
						Dim As Double res = result
						GetToken
						Parenthesized(res)
						Select Case Func
							Case "ABS": result = Abs(res)
							Case "ATN": result = Atn(res)
							Case "COS": result = Cos(res)
							Case "EXP": result = Exp(res)
							Case "FAC"
								If (Res<0) Then
									sError("argument to factorial must be positive")
								Else
									Result=1
									For i As Integer =1 To Res
										Result*=i
									Next
								End If
							Case "FIX": result = Fix(res)
							Case "INT": result = Int(res)
							Case "LOG": result = Log(res)
							Case "RND": result = Rnd(res)
							Case "SGN": result = Sgn(res)
							Case "SIN": result = Sin(res)
							Case "SQR": result = Sqr(Abs(res))
							Case "TAN": result = Tan(res)
						End Select
					Else
						sError("unknow ident / function " & Token)
					End If
			End Select
		End If
End Sub

Function Eval(e As String) As Double
	Dim As Double result
	Expression=e 
	cPos=0
	GetToken()
	AddSub(result)
	Return result
End Function

Dim As String e
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
Print e & " = " & Eval(e)
Sleep
I could swear there is an END IF missing from Parenthesized because the indents don't align near end, but it works on Euler's!

Dang it! It's the Browser or Forum Editor!!! ;(
bplus
Posts: 56
Joined: May 01, 2017 15:57

Re: EVAL

Post by bplus »

Well I got my JB version translated to FB and working. Turns out some Booleans are easier than others. Apparent success with =, >, <, >=, <=, <> but no luck with AND and OR. Plus, it's supposed to flag errors if it finds a function that isn't known but doesn't, a work in progress.

Using some Word Tools posted the other day:

Code: Select all

' EVAL 1 bplus.bas for FB (B+=MGA) 2017-07-03
'based on successful: evalW 2.txt for JB [B+=MGA] 2017-03-11 repost with edits

Const XMAX = 1200
Const YMAX = 720
Const PI = Acos(-1)
Const RAD = PI/180.0
Const DEG = 180/PI

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
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
Common Shared As Double DFlag, GlobalX

DFlag = 1 : GlobalX = 5  'changeable
Dim As String e
Dim As Double r

'  tests
'e = "log(0)"  'err
'e = "exp(-694) " 'err
'e = "exp(-693) "     ' 1.0812... E-301 bottom limit no error on my system, -708 on another test
'e = "exp( 709) "    ' 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
'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 = "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 = 99 % 9"
'e = "23 >= 22"

'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
? "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
	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
		EndIf	
		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 = Str(GlobalX)
				Case 2 : subst = Str(Exp(1))
				Case 3 : subst = 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 As String) As Double
	Dim As Integer pop, lPlace, i, rPlace, wc, po, funPlace, recurs, p, o
	Dim As String fun, w, test, inner, ops, op, middle
	Dim As Double a, b, innerV, m
	
	? "EvalW gets: ";s
	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 asin acos atan log exp sqr rad deg", test)
			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 -693 <= 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 only works for ABS(number) <= ??? using 693." : 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, Str(m))
		pop = wIn(s, "(")
	Wend
	
	ops = "% ^ / * - + = < > <= >= <>"   'all () cleared, now for binary ops
	For o = 1 To 12
		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)
				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" 
			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 

Drago
Posts: 116
Joined: Aug 10, 2005 13:15

Re: EVAL

Post by Drago »

D.J.Peters wrote:impossible for human ;-)
MayBe....MayBeNot

;)
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: EVAL

Post by MrSwiss »

bplus wrote:Turns out some Booleans are easier than others. Apparent success with =, >, <, >=, <=, <> but no luck with AND and OR.
And as well as Or (Xor, etc.) are NOT 'Booleans', they are 'Binary' operators,
in contrast to: AndAlso and OrElse (Boolean, short-cut operators).

Short-cut means:
If first condition <> *match then, the second condition isn't even evaluated.
*match = TRUE or FALSE, depending on operator used ...
Post Reply