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


DJPeter Expression Evaluator
07-02-2017, 03:53 PM
Post: #1
 (Print Post)
DJPeter Expression Evaluator
Here is version in Oxygen basic
original by DJPeter from FreeBasic forum
-not exactly finished but is very simple in 200 LOC and can be optimized..

Code Snippet: [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
 if token = "SIN"   
       return TRUE
 end if
  'print sError("Unknown function?... " + token)
  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
          float res : res = result
          print "IDENT:" + Func
          GetToken()
          Parenthesized(res)
          'select Func
         ' 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)
          if Func = "SIN" then result = sin(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)

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-03-2017, 04:50 AM
Post: #2
 (Print Post)
RE: DJPeter Expression Evaluator
In addition you may compare my Ruben expression evaluator
with DJPeter Math solver and you will see that is almost
the same ,as conclusion i will add that both of are derived from
somewhere ,my is derived from tronD,which is used also from
somewhere else,code simply mutate trough languages but
base construction is same.


Attached File(s) Image(s)
   

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-03-2017, 09:57 AM
Post: #3
 (Print Post)
RE: DJPeter Expression Evaluator
I am glad because Charles give me option
using string pointers and now SELECT detect strings
so filtering work:

Code Snippet: [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
 'beepleep: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)


Attached File(s) Image(s)
   

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



Forum Jump:


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




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