RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: Aurel on July 04, 2017, 07:03:39 AM
-
HI
here is version of DJPeter math solver - expression evaluator
in Oxygen Basic - using string pointers to compare strings( math functions)
' simple expression solver FB DJPeters
'Oxygen basic version by Aurel
declare sub Unary (byref Result as float)
declare sub Parenthesized(byref Result as float)
declare sub Exponent (byref Result as float)
declare sub MulDiv (byref Result as float)
declare sub AddSub (byref result as float)
'declare sub DoUnary (Op as string,byref Result as double)
declare sub GetToken()
declare function IsDigit() as int
declare function IsAlpha() as int
declare function IsWhite() as int
declare function IsDelimiter() as int
declare function isFunction() as int
'enum TokenTypes / integer constant
% EOL = 1
% DELIMETER = 2
% NUMBER = 3
% IDENT = 4
'end enum
string Expression,Token,ch
int TokenType,cPos,TRUE=1,FALSE=0
sub sError(sErr as string)
print "Error: " & sErr
'beep:sleep:end
end sub
'---------------------------------
function IsDigit() as int
int c: c=asc(ch)
if c>47 and c<58 or c=46
return TRUE
end if
return FALSE
end function
'--------------------------------
function IsAlpha() as int
int c: c=asc(ucase(ch))
if c>64 and c<91
return TRUE
end if
return FALSE
end function
'---------------------------------
function IsWhite() as int
int c : c=asc(ch)
return ((c=32) or (c=9))
end function
'---------------------------------
function IsDelimeter() as int
int c: c=asc(ch)
if c=9 then return TRUE
c=instr("+-*/^()",ch)
if c>0 then return TRUE
return FALSE
end function
'---------------------------------------
function IsFunction() as int
int *f = strptr token
Select f
case "SIN"
return TRUE
case "COS"
return TRUE
case "TAN"
return TRUE
case "SQR"
return TRUE
end select
return FALSE
end function
'----------------------------------------
sub GetChar
cPos=cPos+1
if cPos>len(Expression) then
ch="":return
end if
ch = mid(Expression,cPos,1)
end sub
'---------------------------------------
sub GetToken()
GetChar()
if Ch="" then
Token = ""
TokenType = EOL
return
end if
if IsDelimeter()= TRUE then
Token = Ch
TokenType = DELIMETER
return
end if
if IsDigit()= TRUE then
Token = ""
while IsDelimeter()=FALSE and Ch<>""
Token=Token+Ch
GetChar()
wend
TokenType = NUMBER
cPos=cPos-1
return
end if
if IsAlpha() = TRUE then
Token = ""
while IsAlpha()=TRUE and Ch<>""
Token = Token + Ch
GetChar()
wend
'print "TOKEN:" & token
Token= UCASE(Token)
TokenType = IDENT
cPos=cPos-1
return
end if
end sub
'---------------------------------------------
sub AddSub(byref Result as float)
string Op
float Temp
Unary(result)
Op=Token
while Op = "+" or Op = "-"
GetToken()
Unary(Temp)
if Op="+" then
Result=Result+Temp
end if
if Op="-"
Result=Result-Temp
end if
Op = Token
wend
end sub
sub Unary(byref Result as float)
string Op
if TokenType=DELIMETER and (Token="+" or Token="-")
Op = Token
GetToken()
end if
MulDiv(Result)
if Op="-" then Result = -Result
end sub
sub MulDiv(byref Result as float)
string Op
float Temp
Exponent(Result)
Op=Token
while Op = "*" or Op = "/"
GetToken()
Exponent(Temp)
if op="*" then
Result *= Temp
else
if (Temp=0) then
sError("division by zero")
else
Result = Result / Temp
end if
end if
Op = Token
wend
end sub
sub Exponent(byref Result as float)
float Temp
Parenthesized(Result)
if (Token="^") then
GetToken()
Parenthesized(Temp)
Result ^= Temp
end if
end sub
sub Parenthesized(byref Result as float)
if token = "-" or token = "+" then Unary(Result)
if (Token ="(") and (TokenType = DELIMETER) then
GetToken()
AddSub(Result)
if (Token <> ")") then serror("unbalanced round brackets")
GetToken()
else
select TokenType
case NUMBER
Result = val(Token)
GetToken()
case IDENT
if IsFunction()= TRUE then
string Func : Func = Token
int *p = strPtr Func
float res : res = result
GetToken()
Parenthesized(res)
select p
' case "ABS": result = abs(res)
' case "ATN": result = atn(res)
case "COS": result = cos(res)
'case "EXP": result = exp(res)
'case "FIX": result = fix(res)
'case "INT": result = int(res)
'case "LOG": result = log(res)
'case "SGN": result = sgn(res)
case "SIN": result = sin(res)
case "SQR": result = sqr(res)
case "TAN": result = tan(res)
end select
else
serror("unknow ident / function " & Token)
end if
end select
end if
end sub
function Eval(byval s as string) as float
float result
Expression=s
cPos=0
GetToken()
AddSub(result)
return result
end function
string e
e = "sin(2+3)"
print e & " = " & Eval(e)
-
It may sound like cheating, but as a reference, there is a free GNU library which can do this for you: libmatheval (https://www.gnu.org/software/libmatheval/)
Some BASIC's (and other type of languages) can import its functions using the 'dlopen' API and evaluate any string based expression. Example:
IMPORT "evaluator_create(char*)" FROM "libmatheval.so.1" TYPE void*
IMPORT "evaluator_evaluate(void*, int, char**, double*)" FROM "libmatheval.so.1" TYPE double
IMPORT "evaluator_destroy(void*)" FROM "libmatheval.so.1" TYPE void
'------------------------------------------------------------------------
DECLARE f TYPE void*
'------------------------------------------------------------------------
expression$ = "5*(3+1)" ' An expression without variables
f = evaluator_create(expression$)
PRINT evaluator_evaluate(f, 0, NULL, NULL)
evaluator_destroy(f)
'------------------------------------------------------------------------
DECLARE var$[] = { "x" } ' The expression uses a variable called x
DECLARE nr[] = { 0.1 } TYPE double ' The variable has value 0.1
expression$ = "6+x*50" ' The expression to be calculated
f = evaluator_create(expression$)
PRINT evaluator_evaluate(f, 1, var$, nr)
evaluator_destroy(f)
-
Another way to "cheat" ;)
http://retrogamecoding.org/board/index.php?topic=467.0
-
Hello boys ..
stop cheating ;D
One good and simple exaample post Richard Russell ,yes
author of BB4W on his LBBooster forum ,his example must work almost on any basic
and that is what i like :D
-
I thought that most BASICs had some sort of EVAL function built in that can evaluate pretty much any expression you care to give it? I know Sinclair BASIC back in '82 (and possible as far back as '80) definitely had one.
-
Business BASIC has had EXECUTE("a = 1 + 1") for as long as I can remember. (1980 ->)
Script BASIC executes its dynamic string code in a thread.
-
I thought that most BASICs had some sort of EVAL function built in that can evaluate pretty much any expression you care to give it? I know Sinclair BASIC back in '82 (and possible as far back as '80) definitely had one.
I thought a version of the Quick Basic (QB) line had EVAL back in the 90's because I remember that from the one I purchased (for compiling stand alones) or in VB for MS DOS from that time. Apparently it has gone missing in all free BASICs from that line of evolution including Free Basic, QB64 and it's fork and JB. JB doesn't have it nor is it planned for the long awaited JB 2.0 that Carl has recently announced. It is in Liberty Basic and maybe the LB Booster (I think, if Richey is still looking in he might verify.) SmallBASIC has the work around but it's not the same as build-in.
BTW Richard's sweet simple version of EVAL with () posted in a thread called Basic in a Basic at the JB forum has been disappeared quite mysteriously and without explanation along with the entire thread! It disappeared the same day Richard posted so might be part of the on going feud between Richard and Rod (or is Rod acting as Carl's minion?) or, of course, another reason entirely! I wonder how much Carl is aware of Rod' censorship. In whose vision is the forum being molded?
(edits right after post for clarity and information)
-
or is Rod acting as Carl's minion?
Mark
not OR than IS Carl servant,like some others mods on that forum
as i said that place sucks like his new version
what a "new features" sucks too,
Richard have right:in open reply to Carl(my add: super-ultra OOP programmer)
Carl should have swallowed his pride, learned the true reason for the allocation failures (rather than trying to blame Microsoft)
that explain a lot
-
Hi Aurel,
I tried to recreate Richard's code from the code at LBB without the ().
I found out my VAL() and MID() do not work the same as his. I like his, better!
VAL() returns something until it hits a non number thing, NOT 0 if say there is a + sign in the string, like Val("99 bottles of beer.") = 99
NOT 0
MID("thisIsTooShort", 99) = ""
NOT Crash with Error message.
So with those fixed, I can't tell if his can handle -3--2? because my modified one doesn't but does OK with all other things, I think. No! negative signs aren't working eg 1-2 no, but 1 -2 OK?
' EVAL trans & mod of Richard.bas SmallBASIC 0.12.9 (B+=MGA) 2017-07-20
' Dang it! JB deleted Richard's LBB translation and mod for ()
' Here it is before () handled? can I recreate Richard's with ()
' copied from LBB forum 2017-07-20
' hmm... how much do I remember from my short study?
' this thing is barely working need to fix -- and spaces
dim pcp(5)
pcp(1) = 1 : pcp(2) = 1 : pcp(3) = 2 : pcp(4) = 2 : pcp(5) = 3
' Test of expression evaluator
'e = "-3*-2" 'wow OK
'e = "-3--2" '2? nope
'e = "-3/-2" 'OK
e = "2 ^ 4" 'nope 1
e = "2^4" 'OK
e = "1-2" '+3-4+5-6+7-8
e = "1 -2+3 -4+5 -6+7 -8" 'O
op = 0 : pr = 1 : x = 99 '???
r = evaluate(e, op, pr, x)
? r
pause
func evaluate(byref e, byref posOper, byref precedence, x)
local copyPosOper, copyPrecedence, copyX, i, getValPos
? "evaluate gets ";e
repeat
copyPosOper = posOper
copyPrecedence = precedence
copyX = x
'x = val(e) '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< this is returning 0 if any operators are present
getValPos = len(e)
for i = 1 to len(e)
if instr("-.0123456789", mid(e, i, 1)) = 0 then getValPos = i - 1 : exit for
next
x = val(mid(e, 1, getValPos))
'print "x = ";x
repeat
'? "Inner repeat e = ";e
if len(e) < 2 then
posOper = 0
else
e = mid(e, 2)
posOper = instr(1, "+-*/^", left(e, 1))
fi
until posOper<>0 or len(e) < 2
if len(e) > 1 then e = mid(e, 2) ' Skip past operator
precedence = pcp(posOper)
while precedence > copyPrecedence : x = evaluate(e, posOper, precedence, x) : wend
'temp = copyX : copyX = x : x = temp
swap x, copyX
select case copyPosOper
case 0: x = copyX
case 1: x = x + copyX
case 2: x = x - copyX
case 3: x = x * copyX
case 4: x = x / copyX
case 5: x = x ^ copyX
end select
until precedence < copyPrecedence
evaluate = x
end
-
Here is an example of Script BASIC's EVAL() function.
IMPORT sbt.sbi
FUNCTION EVAL(expcode)
sb = SB_New()
SB_LoadStr(sb, expcode)
SB_Run(sb, "")
EVAL = SB_GetVar(sb, "main::result")
SB_Destroy(sb)
END FUNCTION
expression = "result = 2 ^ 4"
PRINT EVAL(expression),"\n"
jrs@jrs-laptop:~/sb/examples/test$ time scriba eval.sb
16
real 0m0.009s
user 0m0.008s
sys 0m0.004s
jrs@jrs-laptop:~/sb/examples/test$
-
Here is an example of Script BASIC's EVAL() function.
IMPORT sbt.sbi
FUNCTION EVAL(expcode)
sb = SB_New()
SB_LoadStr(sb, expcode)
SB_Run(sb, "")
EVAL = SB_GetVar(sb, "main::result")
SB_Destroy(sb)
END FUNCTION
expression = "result = 2 ^ 4"
PRINT EVAL(expression),"\n"
jrs@jrs-laptop:~/sb/examples/test$ time scriba eval.sb
16
real 0m0.009s
user 0m0.008s
sys 0m0.004s
jrs@jrs-laptop:~/sb/examples/test$
That's really quite interesting - the expression is "Result = 2 ^ 4" which in itself has no actual result to print - it assigns a variable. I take it that the variable itself is special in this case?
In SpecBAS, you would do PRINT VAL "2^4" which would get the same result. Assignment would require the EXECUTE command, which isn't a function and therefore would not be able to be used by PRINT.
What would be even more interesting is PRINT EVAL("a=2^4") - what would you get then?
-
Paul,
It was just a quick & dirty EVAL example showing the threading feature of Script BASIC. I'm sure a smarter EVAL() function could be assembled.
result was just a variable I used. It could have been A. The expression could have been a complete multi-line program.
-
SpecBAS uses a similar Result variable when calling procedures as functions, but I didn't spot it in your code at first. Makes sense now I re-read it :)
-
Hi Aurel,
I tried to recreate Richard's code from the code at LBB without the ().
Hi - Yo - Mark
Yes his method is very close to what i have in plan and is very neat and simple....
i forget to test it in o2...
-
EVAL...It is in Liberty Basic and maybe the LB Booster (I think, if Richey is still looking in he might verify.)
I still check in now and again when I can find the time :)
Yes, LBB does indeed have EVAL
PRINT EVAL ("1 + 2")
END
output = 3
Btw I'm not sure why people still use JB when LBB is also free to download and use and has the additional advantage of having all of the features of Liberty BASIC (which JB does not) but without the bugs ::)
-
I thought that most BASICs had some sort of EVAL function built in that can evaluate pretty much any expression you care to give it? I know Sinclair BASIC back in '82 (and possible as far back as '80) definitely had one.
5 REM Sinclair BASIC and SpecBAS
10 PRINT VAL ("1 + 2")
20 STOP
Yes, the old ones (and the re-imagined old ones ;)) are the best :)
-
I cleaned up the Script BASIC EVAL function to make it more traditional.
IMPORT sbt.sbi
FUNCTION EVAL(expcode)
sb = SB_New()
SB_LoadStr(sb, "result = " & expcode)
SB_Run(sb, "")
EVAL = SB_GetVar(sb, "main::result")
SB_Destroy(sb)
END FUNCTION
PRINT EVAL("2 ^ 4"),"\n"
PRINT EVAL("(10 + 6) / 4"),"\n"
PRINT FORMAT("%.3f",EVAL("SQR(3)")),"\n"
PRINT EVAL("""\"Hello " & "World\""""),"\n"
EVAL("""0
FOR x = 1 TO 5
PRINT x,"\\n"
NEXT""")
jrs@jrs-laptop:~/sb/examples/test$ time scriba eval.sb
16
4
1.732
Hello World
1
2
3
4
5
real 0m0.009s
user 0m0.008s
sys 0m0.004s
jrs@jrs-laptop:~/sb/examples/test$
-
EVAL...It is in Liberty Basic and maybe the LB Booster (I think, if Richey is still looking in he might verify.)
I still check in now and again when I can find the time :)
Yes, LBB does indeed have EVAL
PRINT EVAL ("1 + 2")
END
output = 3
Btw I'm not sure why people still use JB when LBB is also free to download and use and has the additional advantage of having all of the features of Liberty BASIC (which JB does not) but without the bugs ::)
Hi Richey!
Hey you're still alive! You make a fine point about JB and I did forget about LB also!!!
I have recently downloaded it again but I have been distracted by FreeBasic and then QB64. Both have very active forums with experienced people and smart wits ta boot! I learn my ship through forums now that they don't write books for this stuff. People are more fun than books anyway, ... well... they can be. ;-))
PS It was the EVAL with () that Richard posted at JB forum that had me downloading LBB again. Alas, that post, that whole thread was deleted without explanation. >:(
-
Hey you're still alive! You make a fine point about JB and I did forget about LB also!!!...I learn my ship through forums now that they don't write books for this stuff. People are more fun than books anyway, ... well... they can be. ;-))
PS It was the EVAL with () that Richard posted at JB forum that had me downloading LBB again. Alas, that post, that whole thread was deleted without explanation. >:(
Hi B+
:)
You could always still visit the JB forum but have you thought about joining the LB Booster conforum as well? I see that Aurel is a member. I'm sure that Richard and the community would appreciate your code examples, which you could post under the 'Showcase' section.
Best wishes
Richey
-
PS It was the EVAL with () that Richard posted at JB forum that had me downloading LBB again. Alas, that post, that whole thread was deleted without explanation. >:(
hello B+, can you re-post Richard's eval? I am curious.
-
Hi jbk,
As close as I can get is here:
http://lbb.conforums.com/index.cgi?board=code&action=display&num=1500109758
The one with parenthesis posted at JB didn't seem any longer than that. Richard even asked if anyone could make a shorter one.
In fact, as I remember the one at JB, it seemed shorter!
The tricks of memory? Like the fish that got away keeps getting bigger and bigger with every retelling of the story. :)
PS (To continue my teaser from "Write a program..." thread in Discussion Board):
I have something very short and sweet. It totally by passes PCP worries and the use of parenthesis. But alas, it leaves allot more work to coder. I have found the bug that has plagued me for some time, just need to test more and write up a document (it needs some explaining because so short). Stay tuned...
-
thank yo B+ :)