Another easy to understand expression solver.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Post by srvaldez »

it's not a bug, exponentiation is performed before negation, why do you think mathematicians enclose negated numbers in parenthesis? (-1)^n for example, I think what confuses you is that is that the minus sign is not attached to the number, so a number is treated as positive then negated.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

hello srvaldez
i added your new priority rules and FAC(X),SQR(ABS(X))

if you have fun and time you can change the digit parsing

only one dot should be allowed in a float number e.g. "3.14.56"

floats are allowed to start with a dot too e.g. ".314"

or the missing e notation "123.456-E10" , "123.456+e10"

Joshy
Rens
Posts: 256
Joined: Jul 06, 2005 21:09

Post by Rens »

Removed by me
Last edited by Rens on Oct 27, 2010 17:32, edited 1 time in total.
AGS
Posts: 1284
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Post by AGS »

srvaldez wrote:it's not a bug, exponentiation is performed before negation, why do you think mathematicians enclose negated numbers in parenthesis? (-1)^n for example, I think what confuses you is that is that the minus sign is not attached to the number, so a number is treated as positive then negated.
You're right, the minus attachment is what confused me. My mistake.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Post by srvaldez »

it happened to me too, it seems logical that it would be considered part of the number.
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

These expression engines really fascinate me.

You could really put a bunch of power into an image editor, if you gave it variables and expressions it could use, just like graphing, and also to measure things like aspect ratio, and re-calculate objects based on new sizes.



~Kiyote!
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

i added 26 vars from "A" to "Z" and the speed for unoptimized string parsing isn't bad.
i get around 44,000 call's per second (time of gfx included)

new are SetVar("X",value)

NOTE: SetVar("B",value) is the same as SetVar("b",value)

Joshy

Code: Select all

' simple math parser and solver
type float as single ' or double

declare sub Add_Sub       (byref result as float)
'declare sub GetToken

enum TokenTypes
  EOL
  DELIMETER
  NUMBER   ' integer or float
  IDENT    ' function or var
end enum

dim shared as string  Expression,Token,Char
dim shared as integer LenExpression,TokenType,CurrentPos,CharA
dim shared as float  Vars(25)

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

' SetVar("A",123.456)
sub SetVar(nam as string,value as float)
  nam = trim(nam)
  if len(nam)<>1 then 
    serror("name of var '" & nam & "' has more then one letter ('A'...'Z')")
  else  
    dim as integer index = asc(ucase(nam))-65
    if (index<0) or (index>25) then
      serror("var name '" & nam & "' is out of range (A...Z)")
    else
      Vars(index)=value
    end if
  end if  
end sub
' value = GetVar("R")
function GetVar(v as string) as float
  dim as integer index = asc(v)-65
  if (index<0) or (index>25) then
    serror("GetVar '" & v & "' is out of range (A...Z)")
  else
    return Vars(index)
  end if
end function

' 0-9
function IsDigit() as integer
  dim as integer aChar=asc(Char)
  return ((aChar>47) and (aChar<58))
end function
' a-z,A-Z
function IsAlpha() as integer
  dim as integer aChar=asc(Char)
  return ((aChar>64) and (aChar<91))
end function
' " ", TAB
function IsWhite() as integer
  dim as integer aChar=asc(Char)
  return ((aChar=32) or (aChar=9))
end function
' -+/*^()
function IsDelimeter() as integer
  dim as integer aChar=asc(Char)
  if aChar=9 then return 1
  return (instr("-+/*^()",Char)>0)
end function
' math 
function IsFunction() as integer
  return (instr("ABS,ATN,COS,RND,SIN,TAN",Token)>0)
end function

' "A"..."Z" ?
function IsVar() as integer
  if len(Token)<>1 then return 0
  dim as integer aChar=asc(token)
  return ((aChar>64) and (aChar<91))
end function

sub GetChar
  CurrentPos+=1
  if CurrentPos>lenExpression then
    char="":return
  end if
  Char=mid(Expression,CurrentPos,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
    CurrentPos-=1
    return
  end if
  
  if IsAlpha() then
    Token = ""
    while IsAlpha() and Char<>""
      Token = Token & Char : GetChar
    wend
    TokenType = IDENT
    CurrentPos-=1
    return
  end if
end sub

' priority 1 (higest in math)
sub Parenthesized(byref Result as float)
  if (Token ="(") and (TokenType = DELIMETER) then
    GetToken()
    Add_Sub(Result)
    if( Token <> ")") then
      serror("unbalanced round brackets")
    end if
    GetToken()
  else
    select case TokenType
    case NUMBER : Result = val(Token) : GetToken
    case IDENT
      if IsVar() then
        Result = GetVar(Token) : GetToken
      elseif IsFunction() then
        dim as string Func = Token
        dim as float res  = result
        GetToken:Parenthesized(res)
        select case Func
        case "ABS":result=abs(res)
        case "ATN":result=atn(res)
        case "COS":result=cos(res)
        case "RND":result=rnd(res)
        case "SIN":result=sin(res)
        case "TAN":result=tan(res)
        case else : serror("ident '" & func & "' isn't a function")
        end select
      else
        serror("ident '" & token & "' isn't a var or function")
      end if
    end select
  end if
end sub

' priority 2
sub Unary(byref Result as float)
  dim as string Op
  if (TokenType=DELIMETER) then
    if ((Token="+") or (Token="-")) then
      Op = Token : GetToken()
    end if  
  end if
  Parenthesized(Result)
  if (Op="-") then Result = -Result
end sub

' priority 3
sub Exponent(byref Result as float)
  Unary(Result)
  if (Token="^") then
    GetToken()
    dim as float Temp
    Exponent(Temp)
    result ^= temp
  end if
end sub

' priority 4
sub Mul_Div(byref Result as float)
  dim as string Op
  dim as float Temp
  Exponent(Result)
  Op=Token
  while Op = "*" or Op = "/"
    GetToken()
    Exponent(Temp)
    if op="*" then
      result*=temp
    elseif op="/" then 
      result/=temp
    else
      sError("wrong operator '" & Op & "' /,* are ecxepted")  
    end if
    Op = Token
  wend
end sub

' priority 5 (lowest in math)
sub Add_Sub(byref Result as float)
  Mul_Div(result)
  dim as string Op=Token
  dim as float Temp
  while Op = "+" or Op = "-"
    GetToken()
    Mul_Div(Temp)
    if op="-" then
      result-=temp
    elseif op="+" then 
      result+=temp
    else
      sError("wrong operator '" & Op & "' +,- are ecxepted")  
    end if
    Op = Token
  wend
end sub

function Solve(e as string) as float
  dim as float result
  e=trim(e)
  LenExpression=len(e)
  ' no expression at all
  if LenExpression<1 then return 0
  e=ucase(e)
  Expression=e ' make expression global
  CurrentPos=0 ' read read pointer
  GetToken()
  ' start with lowest priority
  Add_Sub(result)
  return result
end function

'
' test
'
const scr_w = 640
const scr_h = 480

screenres scr_w,scr_h

' expression for x,y
dim as string EX = "cos(a)*r"
dim as string EY = "sin(a)*r"
dim as double te,ts=Timer
dim as integer ecount 

' test with gfx
for r as float=1 to scr_h/2
  SetVar("r",r) ' [r]adius
  screenlock
  for a as float=0 to 6.28 step 0.01
    SetVar("a",a)
    dim as float x = Solve(EX)
    dim as float y = Solve(EY)
    pset(scr_w/2+x,scr_h/2+y),r
    ecount+=2 ' count how often we call Solve()
  next
  screenunlock  
next
te=timer:ts=te-ts
print "seconds over all       = " & ts
print "number of solver calls = " & ecount
print "expression per second  = " & str(int(ecount/ts))
print
sleep
Last edited by D.J.Peters on Dec 16, 2011 16:26, edited 1 time in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

next feature:
you can assign the result of expression to a var inside the expression.
but the asignment must be the first part of the expression

here are what i mean

"x=cos(a)*r"
y="h+sin(a*x)*r"
x="w+x"

Joshy

Code: Select all

' simple math parser and solver
type float as single ' or double

declare sub Add_Sub       (byref result as float)
'declare sub GetToken

enum TokenTypes
  EOL
  DELIMETER
  NUMBER   ' integer or float
  IDENT    ' function or var
end enum

dim shared as string  Expression,Token,Char
dim shared as integer LenExpression,TokenType,CurrentPos,CharA
dim shared as float  Vars(25)

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

' SetVar("A",123.456)
sub SetVar(nam as string,value as float)
  nam = trim(nam)
  if len(nam)<>1 then 
    serror("name of var '" & nam & "' has more then one letter ('A'...'Z')")
  else  
    dim as integer index = asc(ucase(nam))-65
    if (index<0) or (index>25) then
      serror("var name '" & nam & "' is out of range (A...Z)")
    else
      Vars(index)=value
    end if
  end if  
end sub
' value = GetVar("R")
function GetVar(v as string) as float
  dim as integer index = asc(v)-65
  if (index<0) or (index>25) then
    serror("GetVar '" & v & "' is out of range (A...Z)")
  else
    return Vars(index)
  end if
end function

' 0-9
function IsDigit() as integer
  dim as integer aChar=asc(Char)
  return ((aChar>47) and (aChar<58))
end function
' a-z,A-Z
function IsAlpha() as integer
  dim as integer aChar=asc(Char)
  return ((aChar>64) and (aChar<91))
end function
' " ", TAB
function IsWhite() as integer
  dim as integer aChar=asc(Char)
  return ((aChar=32) or (aChar=9))
end function
' -+/*^()
function IsDelimeter() as integer
  dim as integer aChar=asc(Char)
  if aChar=9 then return 1
  return (instr("-+/*^()",Char)>0)
end function
' math 
function IsFunction() as integer
  return (instr("ABS,ATN,COS,RND,SIN,TAN",Token)>0)
end function

' "A"..."Z" ?
function IsVar() as integer
  if len(Token)<>1 then return 0
  dim as integer aChar=asc(token)
  return ((aChar>64) and (aChar<91))
end function

sub GetChar
  CurrentPos+=1
  if CurrentPos>lenExpression then
    char="":return
  end if
  Char=mid(Expression,CurrentPos,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
    CurrentPos-=1
    return
  end if
  
  if IsAlpha() then
    Token = ""
    while IsAlpha() and Char<>""
      Token = Token & Char : GetChar
    wend
    TokenType = IDENT
    CurrentPos-=1
    return
  end if
end sub

' priority 1 (higest in math)
sub Parenthesized(byref Result as float)
  if (Token ="(") and (TokenType = DELIMETER) then
    GetToken()
    Add_Sub(Result)
    if( Token <> ")") then
      serror("unbalanced round brackets")
    end if
    GetToken()
  else
    select case TokenType
    case NUMBER : Result = val(Token) : GetToken
    case IDENT
      if IsVar() then
        Result = GetVar(Token) : GetToken
      elseif IsFunction() then
        dim as string Func = Token
        dim as float res  = result
        GetToken:Parenthesized(res)
        select case Func
        case "ABS":result=abs(res)
        case "ATN":result=atn(res)
        case "COS":result=cos(res)
        case "RND":result=rnd(res)
        case "SIN":result=sin(res)
        case "TAN":result=tan(res)
        case else : serror("ident '" & func & "' isn't a function")
        end select
      else
        serror("ident '" & token & "' isn't a var or function")
      end if
    end select
  end if
end sub

' priority 2
sub Unary(byref Result as float)
  dim as string Op
  if (TokenType=DELIMETER) then
    if ((Token="+") or (Token="-")) then
      Op = Token : GetToken()
    end if  
  end if
  Parenthesized(Result)
  if (Op="-") then Result = -Result
end sub

' priority 3
sub Exponent(byref Result as float)
  Unary(Result)
  if (Token="^") then
    GetToken()
    dim as float Temp
    Exponent(Temp)
    result ^= temp
  end if
end sub

' priority 4
sub Mul_Div(byref Result as float)
  dim as string Op
  dim as float Temp
  Exponent(Result)
  Op=Token
  while Op = "*" or Op = "/"
    GetToken()
    Exponent(Temp)
    if op="*" then
      result*=temp
    elseif op="/" then 
      result/=temp
    else
      sError("wrong operator '" & Op & "' /,* are ecxepted")  
    end if
    Op = Token
  wend
end sub

' priority 5 (lowest in math)
sub Add_Sub(byref Result as float)
  Mul_Div(result)
  dim as string Op=Token
  dim as float Temp
  while Op = "+" or Op = "-"
    GetToken()
    Mul_Div(Temp)
    if op="-" then
      result-=temp
    elseif op="+" then 
      result+=temp
    else
      sError("wrong operator '" & Op & "' +,- are ecxepted")  
    end if
    Op = Token
  wend
end sub

function Solve(e as string) as float
  dim as float result
  e=trim(e)
  LenExpression=len(e)
  ' no expression at all
  if LenExpression<1 then return 0
  e=ucase(e)
  Expression=e ' make expression global
  CurrentPos=0 ' read read pointer
  GetToken()
  if (TokenType=IDENT) and (IsVar()) and (char="=") then
    dim as integer index = asc(Token)-65
    CurrentPos+=1:GetToken()
    Add_Sub(result)
    Vars(index)=result
  else
    Add_Sub(result)
  end if  
  return result
end function

'
' test
'
const scr_w = 640
const scr_h = 480

screenres scr_w,scr_h

' expression for x,y
dim as string EX = "x=cos(a)*r"
dim as string EY = "h+sin(a*x)*r"
dim as string EZ = "w+x"

dim as double te,ts=Timer
dim as integer ecount 
dim as float tmp,x,y

SetVar("w",scr_w/2)
SetVar("h",scr_h/2)

' test with gfx
for r as float=1 to scr_h/2
  SetVar("r",r) ' [r]adius
  screenlock
  for a as float=0 to 6.28 step 0.01
    SetVar("a",a)
    tmp=Solve(EX)
    y=Solve(EY)
    x=Solve(EZ)
    pset(x,y),r
    ecount+=3 ' count how often we call Solve()
  next
  screenunlock  
next
te=timer:ts=te-ts
print "seconds over all       = " & ts
print "number of solver calls = " & ecount
print "expression per second  = " & str(int(ecount/ts))
print
sleep
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

Hi D.J.Peters
I tried your parser a few days ago (from your previous post).

Eval by vbscript is very slow on my machine for some unknown reason, most likley because I have vb6 installed on it.
So, I tried out yours for my 3D surface plot.
Very fast, but I unfortunately couldn't use it because it kicks out with small numbers (1.000001677311957e-005 is an example), it doesn't like the e.
Please try this out with your parser.

Code: Select all

'UNDER YOUR PARSER _______
print "START"
for n as byte=solver("1") to solver("10") :print !"\ " :next

#include "string.bi"
for x as single=-.01 to .01 step .001
'e= format(x/100)
e=str(x/100)
print e,solver(e),x/100

next x

sleep
Maybe you could fix it?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

dodicat wrote:Maybe you could fix it?
Only numbers was allowed no E notation and no dot in front e.g. .123

I was in hope you can add this missing feature self.
How ever here is a working IsDigit() parser put it GetToken().

Joshy

Code: Select all

' any number or "." are a start of number
  if IsDigit() or char="." then
    dim as integer eflag ' e   flag
    Token = ""
    while IsDelimeter()=0 and Char<>""
      Token = Token & Char : GetChar
      ' 123.345e-12 or .123e+12
      if char="E" then 
        if eflag=0 then
          Token = Token & Char:GetChar
          if char="-" or char="+" then
            Token = Token & Char:GetChar
          else
           sError("wrong E notation '+' or '-' are missing")
          end if
          eflag=1
        else
          sError("wrong E notation")
        end if  
      end if    
    wend
    TokenType = NUMBER
    CurrentPos-=1
    return
  end if
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

Thanks D.J.Peters.
I did a quick format to format (string.bi)
It tests ok in your parser.

Code: Select all


print "_format()";tab(30);"format()"
print


#include "string.bi"


function _format(d as double) as string
    #macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
 var part1=Mid$(s,1,position-1)
 var part2=Mid$(s,position)
 s=part1+char+part2
 End if
 #endmacro
    dim as string s=format(d)
    if left(s,2)="-." then 
        insert(s,"0",2):return s
    end if
    if left(s,1)="." then 
        insert(s,"0",1):return s
    end if
    return s
end function


for x as single=-.01 to .01 step .001
print _format(x/100);tab(30);format(x/100)
next x

'TEST
for x as single=-.01 to .01 step .0000013
if val(_format(x/1000)) <> val(format(x/1000)) then
print _format(x/1000),format(x/1000),x/100
end if
next x

print "Test done"
print _format((1.0008e17/50^1.03)^.2),format((1.0008e17/50^1.03)^.2),(1.0008e17/50^1.03)^.2

sleep
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

Code: Select all

' simple math parser and solver
type float as double 

declare sub Add_Sub       (byref result as float)

enum TokenTypes
  EOL      ' end of line
  EOS      ' end of statement ":"
  DELIMETER
  NUMBER   ' integer or float
  IDENT    ' function or var
end enum

dim shared as string  Expression,Token,Char,Code
dim shared as integer LenExpression,TokenType,CurrentPos,CharA
dim shared as float  Vars(25)

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

' SetVar("A",123.456)
sub SetVar(nam as string,value as float)
  nam = trim(nam)
  if len(nam)<>1 then 
    serror("name of var '" & nam & "' has more then one letter ('A'...'Z')")
  else  
    dim as integer index = asc(ucase(nam))-65
    if (index<0) or (index>25) then
      serror("var name '" & nam & "' is out of range (A...Z)")
    else
      Vars(index)=value
    end if
  end if  
end sub
' value = GetVar("R")
function GetVar(v as string) as float
  dim as integer index = asc(v)-65
  if (index<0) or (index>25) then
    serror("GetVar '" & v & "' is out of range (A...Z)")
  else
    return Vars(index)
  end if
end function

' 0-9
function IsDigit() as integer
  dim as integer aChar=asc(Char)
  return ((aChar>47) and (aChar<58))
end function
' a-z,A-Z
function IsAlpha() as integer
  dim as integer aChar=asc(Char)
  return ((aChar>64) and (aChar<91))
end function
' " ", TAB
function IsWhite() as integer
  dim as integer aChar=asc(Char)
  return ((aChar=32) or (aChar=9))
end function
' -+/*^()
function IsDelimeter() as integer
  dim as integer aChar=asc(Char)
  if aChar=9 then return 1
  return (instr("-+/*^()",Char)>0)
end function
' math 
function IsFunction() as integer
  return (instr("ABS,ATN,COS,RND,SIN,TAN",Token)>0)
end function

' "A"..."Z" ?
function IsVar() as integer
  if len(Token)<>1 then return 0
  dim as integer aChar=asc(token)
  return ((aChar>64) and (aChar<91))
end function

sub GetChar
  CurrentPos+=1
  if CurrentPos>lenExpression then
    char="":return
  end if
  Char=mid(Expression,CurrentPos,1)
end sub

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

  if IsDigit() or char="." then
    dim as integer eflag
    Token = ""
    while IsDelimeter()=0 and Char<>""
      Token = Token & Char : GetChar
      ' 123.345e-12 or .123e+12
      if char="E" then 
        if eflag=0 then
          Token = Token & Char:GetChar
          if char="-" or char="+" then
            Token = Token & Char:GetChar
          else
           sError("wrong E notation '+' or '-' are missing")
          end if
          eflag=1
        else
          sError("wrong E notation")
        end if  
      end if    
    wend
    TokenType = NUMBER
    CurrentPos-=1
    return
  end if
  
  if IsAlpha() then
    Token = ""
    while IsAlpha() and Char<>""
      Token = Token & Char : GetChar
    wend
    TokenType = IDENT
    CurrentPos-=1
    return
  end if
end sub

' priority 1
sub Parenthesized(byref Result as float)
  if (Token ="(") and (TokenType = DELIMETER) then
    GetToken()
    Add_Sub(Result)
    if( Token <> ")") then
      serror("unbalanced round brackets")
    end if
    GetToken()
  else
    select case TokenType
    case NUMBER
      Code = Code & "push(" & Token & ")" & chr(10)
      Result = val(Token) : GetToken
    case IDENT
      if IsVar() then
        Result = GetVar(Token) : GetToken
      elseif IsFunction() then
        dim as string Func = Token
        dim as float res  = result
        GetToken
        Parenthesized(res)
        select case Func
        case "ABS":result=abs(res)
        case "ATN":result=atn(res)
        case "COS":result=cos(res)
        case "RND":result=rnd(res)
        case "SIN":result=sin(res)
        case "TAN":result=tan(res)
        case else : serror("ident '" & func & "' isn't a function")
        end select
        Code = Code & "pop()" & chr(10) & "pop()" & chr(10) & "do " & func & chr(10)  & "push(result)" & chr(10)
      else
        serror("ident '" & token & "' isn't a var or function")
      end if
    end select
  end if
end sub

' priority 2
sub Unary(byref Result as float)
  dim as string Op
  if (TokenType=DELIMETER) then
    if ((Token="+") or (Token="-")) then
      Op = Token : GetToken()
    end if  
  end if
  Parenthesized(Result)
  if (Op="-") then
    Code = Code & "pop()" & chr(10) & "do " & Op & chr(10) & "push(result)" & chr(10) 
    Result = -Result
  end if  
end sub

' priority 3
sub Exponent(byref Result as float)
  Unary(Result)
  if (Token="^") then
    GetToken()
    dim as float Temp
    Exponent(Temp)
    Code = Code & "pop()" & chr(10) & "pop()" & chr(10) & "do ^" & chr(10) & "push(result)" & chr(10)
    result ^= temp
  end if
end sub

' priority 4
sub Mul_Div(byref Result as float)
  dim as string Op
  dim as float Temp
  Exponent(Result)
  Op=Token
  while Op = "*" or Op = "/"
    GetToken()
    Exponent(Temp)
    Code = Code & "pop()" & chr(10) & "pop()" & chr(10) & "do " & Op & chr(10) & "push(result)" & chr(10)
    if op="*" then
      result*=temp
    elseif op="/" then 
      result/=temp
    else
      sError("wrong operator '" & Op & "' /,* are ecxepted")  
    end if
    Op = Token
  wend
end sub

' priority 5 (lowest in math)
sub Add_Sub(byref Result as float)
  Mul_Div(result)
  dim as string Op=Token
  dim as float Temp
  while Op = "+" or Op = "-"
    GetToken()
    Mul_Div(Temp)
    Code = Code & "pop()" & chr(10) & "pop()" & chr(10) & "do " & Op & chr(10) & "push(result)" & chr(10)
    if op="-" then
      result-=temp
    elseif op="+" then 
      result+=temp
    else
      sError("wrong operator '" & Op & "' +,- are ecxepted")  
    end if
    Op = Token
  wend
end sub

function Solve(e as string) as float
  dim as integer index=-1
  dim as float result
  e=trim(e)
  LenExpression=len(e)
  ' no expression at all
  if LenExpression<1 then return 0
  e=ucase(e)
  Expression=e ' make expression global
  CurrentPos=0 ' reset the read pointer
  
  Code=""
  
  GetToken()
  ' any asignment in front ?
  if (TokenType=IDENT) and (IsVar()) and (char="=") then
    index = asc(Token)-65
    ' jump over "=" and get next token
    CurrentPos+=1:GetToken()
  end if  
  
  Add_Sub(result)
  ' any asignment ?
  if index>-1 then Vars(index)=result
 
  return result
end function

'
' test
'


dim as string E = "1+2/4*-sin(1+2/3*2^4)"
? E & " = " & solve(e)
?
? Code
sleep
If anyone will make a script engine or interpreter or compiler or a VM (virtual machine)
you can use this algo (after short changes)
for a code generator too.

you have to replace push(#) /pop() and do operator
with your real instructions

here are the pseudo code output of "1+2/4*-sin(1+2/3*2^4)" for a stack machine.

Joshy
push(1)
push(2)
push(4)
pop()
pop()
do /
push(result)
push(1)
push(2)
push(3)
pop()
pop()
do /
push(result)
push(2)
push(4)
pop()
pop()
do ^
push(result)
pop()
pop()
do *
push(result)
pop()
pop()
do +
push(result)
pop()
pop()
do SIN
push(result)
pop()
do -
push(result)
pop()
pop()
do *
push(result)
pop()
pop()
do +
push(result)
marcov
Posts: 3462
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Post by marcov »

the classic test is always if it groks nested parentheses properly

1+(5+(2+5)*9)*((1+1)*(1+(2+3)))

or so.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: another easy to understand EVAL() expression solver

Post by dodicat »

The parser works fine with nested variables.
But I'm not sure how D.J.Peter's setvar works, so I have used my own.

Code: Select all

   ' PARSER HERE 
' test parser
'
Sub Setvariable(s As String,REPLACE_THIS As String,WITHTHIS As Double)
    var WITH_THIS=Str(WITHTHIS)
    var position=Instr(s,REPLACE_THIS)
    While position>0
        s=Mid(s,1,position-1) & WITH_THIS & Mid(s,position+len(REPLACE_THIS))
        position=Instr(position+len(WITH_THIS),s,REPLACE_THIS)
    Wend
End Sub

dim as double p1,p2,x
dim as string w

 for x=-5 to 5
p1=-12*x^5+8*x^4+0.9*x^3-x^2+x-9
p2=((((-12*x+8)*x+0.9)*x-1)*x+1)*x -9
w="((((-12*x+8)*x+0.9)*x-1)*x+1)*x -9"
''w="-12*x^5+8*x^4+0.9*x^3-x^2+x-9"
print p1,p2,
setvariable(w,"x",x)
print solve(w)
next x
sleep          
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: another easy to understand EVAL() expression solver

Post by aurelVZAB »

hi
first of all i don't know why code panel show ( as &h41 or is this some problem with geshi ?
also i replace char with char$ and then i try ..hmm and it looks that not work...

EDIT: code removed by me..
Last edited by aurelVZAB on Jan 12, 2014 7:53, edited 1 time in total.
Post Reply