' A simple expression parser and math 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 (byref Op as string, byref Result as double)
declare sub GetToken
enum TokenTypes
IS_EOL
IS_DELIMETER
IS_NUMBER
IS_IDENT
end enum
dim shared as string gExpression,Token,char
dim shared as TokenTypes TokenType
dim shared as integer cPos
dim shared as double vars(25) ' A-Z
sub sError(byref sErr as string)
open err for output as #99
print #99, "Error: " & sErr
beep : sleep : end 1
end sub
function getVarIndex(varName as string) as integer
varName=trim(varName)
if len(varName)<>1 then
sError(!" var \"" & varName & !"\" name must be one letter !")
end if
varName=ucase(varName)
var index = asc(varName)-asc("A")
if ((index<0) or (index>25)) then
sError(!" var \"" & varName & !"\" name must be in range of A...Z !")
end if
return index
end function
sub setVar(varName as string,Value as double)
Vars(getVarIndex(varName))=Value
end sub
function getVar(varName as string) as double
return Vars(getVarIndex(varName))
end function
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
function IsVar() as integer
return (instr("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z",Token)>0)
end function
sub GetChar
cPos+=1
if cPos>len(gExpression) then
char="":return
end if
char=mid(gExpression,cPos,1)
end sub
sub GetToken()
GetChar
if Char="" then
Token = ""
TokenType = IS_EOL
return
end if
if IsDelimeter() then
Token = Char
TokenType = IS_DELIMETER
return
end if
if IsDigit() then
Token = ""
while IsDelimeter()=0 and Char<>""
Token=Token+Char
GetChar
wend
TokenType = IS_NUMBER
cPos-=1
return
end if
if IsAlpha() then
Token = ""
while IsAlpha() and Char<>""
Token = Token + Char
GetChar
wend
Token=ucase(Token)
TokenType = IS_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=IS_DELIMETER) and Token="+" or 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 = "*" or 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="-" or token="+" then Unary(Result)
if (Token ="(") and (TokenType = IS_DELIMETER) then
GetToken()
AddSub(Result)
if( Token <> ")") then
serror("unbalanced round brackets")
end if
GetToken()
else
select case TokenType
case IS_NUMBER
Result = val(Token):GetToken
case IS_IDENT
if IsVar() then
if char="=" then
var varName = Token
result=0
GetToken()
AddSub(Result)
setVar(varName,Result)
else
Result = getVar(Token)
GetToken
end if
elseif 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=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 Solver(ExpressionToSolve as string) as double
dim as double result
var nChars=len(ExpressionToSolve)
if nChars <3 then sError(" in Solver expression to short !")
gExpression=""
for i as integer = 0 to nChars-1
if ExpressionToSolve[i]>32 then
gExpression &=chr(ExpressionToSolve[i])
end if
next
nChars=len(gExpression)
if nChars<3 then sError(" in Solver expression to short !")
cPos=0
GetToken()
AddSub(result)
return result
end function
dim as string e
setVar("X",1.0)
setVar("Y",1+2+3)
e = "sqr( -atn( x ) * 4 ^ y )"
print e & " = " & solver(e)
setVar("A",2)
setVar("B",5)
e = "C = A * sqr(B)"
print e & " = " & solver(e)
sleep
Last edited by D.J.Peters on Nov 16, 2018 2:15, edited 11 times in total.
D. J. Peters in your MulDiv sub it devides by integer \
<EDIT> I found out why my addition of the factorial operatorit did not work, forgot to change the other reference to Exponent to Factorial in the MulDiv sub, it works. </EDIT>
D.J.Peters wrote:Do you mean in your example FAC(1+2*3) or 1+2*FAC(3) ?
I mean 1+2*FAC(3), the experiment of adding the factorial operator actually seems to work except when give it an expression like "3!^2" then it will only give the factorial and not the square thereof, but you are right, adding as function is probably better.
' simple math parser and solver
declare sub Factorial (byref Result as double)
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,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
MulDiv(result)
Op=Token
while Op = "+" or Op = "-"
GetToken()
MulDiv(Temp)
if Op="+" then
Result+=Temp
else
Result-=Temp
end if
Op = Token
wend
end sub
sub MulDiv(byref Result as double)
dim as string Op
dim as double Temp
Factorial(Result)
Op=Token
while Op = "*" or Op = "/"
GetToken()
Factorial(Temp)
if op="*" then
Result*=Temp
else
Result/=Temp
end if
Op = Token
wend
end sub
sub Factorial(byref Result as double)
dim as double Temp
dim as integer i
Exponent(Result)
if (Token="!") then
if Result<0 then
print "illegal argument to factorial ";Result
else
temp=1
for i=1 to Result
temp=temp*i
next
end if
Result=temp
end if
end sub
sub Exponent(byref Result as double)
dim as double Temp
Unary(Result)
if (Token="^") then
GetToken()
Exponent(Temp)
Result^=Temp
end if
end sub
sub Unary(byref Result as double)
dim as string Op
if ((TokenType=DELIMETER) and Token="+" or Token="-") then
Op = Token
GetToken()
end if
Parenthesized(Result)
if Op="-" then Result=-Result
end sub
sub Parenthesized(byref Result as double)
if (Token ="(") and (TokenType = DELIMETER) then
GetToken()
AddSub(Result)
if( Token <> ")") then
serror("unbalanced round brackets")
end if
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 "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(res)
case "TAN": result = tan(res)
end select
else
serror("unknow ident / function " & Token)
end if
end select
end if
end sub
function Solver(e as string) as double
dim as double result
Expression=e:cPos=0:GetToken()
AddSub(result)
return result
end function
dim as string e = "1+2*3!"'"1+-2*3^2/5+cos(atn(1)*4)"
while e<>""
input "enter expression ",e
print e & " = " & Solver(e)
wend
sleep
I was not sure about the precedence of the factorial operator so I did a search and was led to believe that the ^ operator was higher but it's not, ! is higher than ^, so here's a version that actually works.
' simple math parser and solver
declare sub Factorial (byref Result as double)
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,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
MulDiv(result)
Op=Token
while Op = "+" or Op = "-"
GetToken()
MulDiv(Temp)
if Op="+" then
Result+=Temp
else
Result-=Temp
end if
Op = Token
wend
end sub
sub MulDiv(byref Result as double)
dim as string Op
dim as double Temp
Exponent(Result)
Op=Token
while Op = "*" or Op = "/"
GetToken()
Exponent(Temp)
if op="*" then
Result*=Temp
else
Result/=Temp
end if
Op = Token
wend
end sub
sub Exponent(byref Result as double)
dim as double Temp
Factorial(Result)
if (Token="^") then
GetToken()
Exponent(Temp)
Result^=Temp
end if
end sub
sub Factorial(byref Result as double)
dim as double Temp
dim as integer i
Unary(Result)
if (Token="!") then
GetToken()
Unary(Result)
if Result<0 then
print "illegal argument to factorial ";Result
else
temp=1
for i=1 to Result
temp=temp*i
next
end if
Result=temp
end if
end sub
sub Unary(byref Result as double)
dim as string Op
if ((TokenType=DELIMETER) and Token="+" or Token="-") then
Op = Token
GetToken()
end if
Parenthesized(Result)
if Op="-" then Result=-Result
end sub
sub Parenthesized(byref Result as double)
if (Token ="(") and (TokenType = DELIMETER) then
GetToken()
AddSub(Result)
if( Token <> ")") then
serror("unbalanced round brackets")
end if
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 "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(res)
case "TAN": result = tan(res)
end select
else
serror("unknow ident / function " & Token)
end if
end select
end if
end sub
function Solver(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+-2*3^2/5+cos(atn(1)*4)"
print e & " = " & Solver(e)
e = "1+2*3!"
print e & " = " & Solver(e) & " ,should = 13"
e = "1+2*3!^2"
print e & " = " & Solver(e) & " ,should = 73"
e = "1+2*3!^2+2*2"
print e & " = " & Solver(e) & " ,should = 77"
e = "1+2/sin(0)"
print e & " = " & Solver(e)
sleep
Sisophon2001 I hope you don't mind responding to your comment to D.J.Peters, his eval procedure does produce the wrong results on the tests you posted, the first test should = 6, calc is wrong also, the second test should = 2.
I took the liberty of rearranging the precedence of his eval procedure and now your tests pass.
' simple math parser and 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,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="+" or 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 = "*" or Op = "/"
GetToken()
Exponent(Temp)
if op="*" then
Result*=Temp
else
Result/=Temp
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="-" or token="+" then Unary(Result)
if (Token ="(") and (TokenType = DELIMETER) then
GetToken()
AddSub(Result)
if( Token <> ")") then
serror("unbalanced round brackets")
end if
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 "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(res)
case "TAN": result = tan(res)
end select
else
serror("unknow ident / function " & Token)
end if
end select
end if
end sub
function Solver(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+-2*3^2/5+cos(atn(1)*4)"
print e & " = " & Solver(e)
e = "2--2^2"
print e & " = " & Solver(e)
e = "--2"
print e & " = " & Solver(e)
e = "1+2/sin(0)"
print e & " = " & Solver(e)
sleep
I recall that the example 2--2^2 was a special case where the -2 was raised to the power of 2, but I cant find any references, so I may be wrong. This is how I remember it from my school days which are long since past.
In this example
2--2^2
You are raising -2^2, so the - belongs to the 2
2--2^2 = 2-(-2^2) = -2
I think that it is an example where some (all?) programming parsers behaves differently from an expression parser, that is why I tested this example.
The LOG function initially confused me. I did not know that FB used natural LOG as default. Can this be corrected easily?
Garvan
Note: I edited this post several times as I made more tests.