DJPeter Math Solver in o2

[Aurel]

HI
here is version of DJPeter math solver - expression evaluator
in Oxygen Basic - using string pointers to compare strings( math functions)

Code: [Select]

' 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)



[Peter]

It may sound like cheating, but as a reference, there is a free GNU library which can do this for you: libmatheval

Some BASIC's (and other type of languages) can import its functions using the 'dlopen' API and evaluate any string based expression. Example:

Code: [Select]

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)


[B+]

Another way to "cheat"
http://retrogamecoding.org/board/index.php?topic=467.0

[Aurel]

Hello boys ..
stop cheating   
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 

[ZXDunny]

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.

[ScriptBasic]

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.

[B+]

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)

[Aurel]

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

[B+]

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?

Code: [Select]

' 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



[ScriptBasic]

Here is an example of Script BASIC's EVAL() function.

Code: [Select]

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$

[ZXDunny]

Here is an example of Script BASIC's EVAL() function.

Code: [Select]

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?

[ScriptBasic]

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. 

[ZXDunny]

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

[Aurel]

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...

[Richly]

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

Code: [Select]

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