Maybe something for the math library... a WIP Math Parser! - keeling - 03-05-2005
Jean Debord had posted some work on a math library for FB. I asked if he had thought about a math parser. The reply was that he wasn't "skilled enough" to do it (I've looked at your work and I doubt that statement).
Personally, I have been looking for a good math parser in BASIC for years (on and off). At one point someone had advised me to use RPN. As a long time user of HP calculators I was comfortable with Postfix notation but just couldn't get my head around how to do it in BASIC. Its been a few years and Jean's work and comment got me thinking and here are the results of that thinking. It is a WIP math parser.
Its undocumented, sloppy, not all of the functions are added yet (although it should be painfully obvious how to add new unary and binary operators) and not perfect.... i.e. its a WIP. But it does show how this can be done if someone else wants to jump in and help clean it up.
PLEASE PLEASE PLEASE test it. I have a bad habit of getting a piece of code to work with the few examples I've through out it and then forget to check other things.
Insert long winded code here.
Code: Option Explicit
Const rpnFALSE As Integer = 0
Const rpnTRUE As Integer = Not rpnFALSE
Const MaxOperators As Integer = 100
Const MaxExpressions As Integer = 100
Const MaxVariables As Integer = 100
Const CurrentNumberOfOperators As Integer = 34
'Operator Constants
Const rpnNAO As Integer = 0 'NOT AN OPERATOR
Const rpnLeftParenthesis As Integer = 1
Const rpnRightParenthesis As Integer = 2
Const rpnPlus As Integer = 3
Const rpnMinus As Integer = 4
Const rpnMultiply As Integer = 5
Const rpnDivide As Integer = 6
Const rpnPercent As Integer = 7
Const rpnIntegerDivision As Integer = 8
Const rpnPow As Integer = 9
Const rpnAbs As Integer = 10
Const rpnAtan As Integer = 11
Const rpnCos As Integer = 12
Const rpnSin As Integer = 13
Const rpnExp As Integer = 14
Const rpnFix As Integer = 15
Const rpnInt As Integer = 16
Const rpnLn As Integer = 17
Const rpnLog As Integer = 18
Const rpnRnd As Integer = 19
Const rpnSgn As Integer = 20
Const rpnSqr As Integer = 21
Const rpnTan As Integer = 22
Const rpnAcos As Integer = 23
Const rpnAsin As Integer = 24
Const rpnCosh As Integer = 25
Const rpnSinh As Integer = 26
Const rpnTanh As Integer = 27
Const rpnAcosh As Integer = 28
Const rpnAsinh As Integer = 29
Const rpnAtanh As Integer = 30
Const rpnMod As Integer = 31
Const rpnFact As Integer = 32
Const rpnNeg As Integer = 33
Const rpnLog10 As Integer = 34
declare Function EvalPostFix(PostFixString As String, NumOfVariables As Integer, Variables() As String) As Double
declare Function ConvertInfixToPostFix(TExpression As String) As String
declare Function PushOperator(ByVal Object As Integer, ByRef StackPointer As Integer, _
Stack() As Integer) As Integer
declare Function PopOperator(ByRef StackPointer As Integer, _
Stack() As Integer) As Integer
declare Function PushExpression(ByRef Object As String, _
ByRef StackPointer As Integer, _
Stack() As String) As Integer
declare Function PopExpression(ByRef StackPointer As Integer, _
Stack() As String) As String
declare Sub Update(ByVal Operator As Integer, ByRef Expression As String, _
ByRef OSP As Integer, ByRef ESP As Integer, _
OStack() As Integer, EStack() As String)
declare Function GetPriority(Operator As Integer) As Integer
declare Function NotOperator(Item As String) As Integer
declare Sub DefineVariables(NumOfVariables As Integer, VariableList() As String)
declare Function FindVariables(PostFix As String, VariableArray() As String) As Integer
declare Function GetOperatorString(Operator As Integer) As String
declare Function rpnIsNumeric(ValString as string) as integer
'-----------------------------------------------------------
'Driver Program
Dim infix As String
Dim PostFix As String
Dim v(MaxVariables) As String
Dim r As Integer
dim i as integer
input$ "Please enter a mathematical expression: ", infix
? "The Infix expression is: "; infix
PostFix = ConvertInfixToPostFix(infix)
?
? "The postfix is: " + PostFix
r = FindVariables(PostFix, v())
if r<> 0 then
?
? "The variables in this expression are:"
for i = 1 to r
? v(i)
next i
?
DefineVariables r, v()
end if
?
? "The evaluated postfix expression is: ";
? EvalPostFix(PostFix, r, v())
sleep
end
'-------------------------------------------------------------
'functions
Function EvalPostFix(PostFixString As String, NumOfVariables As Integer, Variables() As String) As Double
'Valid PostFix String is <something><space><something><space>.......<something><space>
Dim ExpressionStack(MaxExpressions) As String
Dim ESP As Integer
Dim Position As Integer
Dim TokenString As String
Dim WorkingString As String
Dim Var1 As String
Dim Var2 As String
Dim A As Double
Dim B As Double
Dim PushString As String
Dim i As Integer
Dim EPosition As Integer
WorkingString = PostFixString
ESP = 0
Position = InStr(WorkingString, " ")
If Position = 0 Then
Print "ERROR"
End
End If
Do While (Position <> 0)
TokenString = Left$(WorkingString, Position - 1)
WorkingString = Mid$(WorkingString, Position + 1)
Position = InStr(WorkingString, " ")
Select Case TokenString
Case GetOperatorString(rpnPlus)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$(B + A), ESP, ExpressionStack()
Case GetOperatorString(rpnMinus)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$(B - A), ESP, ExpressionStack()
Case GetOperatorString(rpnMultiply)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$(B * A), ESP, ExpressionStack()
Case GetOperatorString(rpnDivide)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$(B / A), ESP, ExpressionStack()
Case GetOperatorString(rpnIntegerDivision)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$(B \ A), ESP, ExpressionStack()
Case GetOperatorString(rpnPow), GetOperatorString(rpnExp)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$(B ^ A), ESP, ExpressionStack()
Case GetOperatorString(rpnMod)
Var1 = PopExpression(ESP, ExpressionStack())
Var2 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
B = Val(Var2)
PushExpression Str$((B Mod A)), ESP, ExpressionStack()
Case GetOperatorString(rpnSin)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Sin(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnCos)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Cos(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnTan)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Tan(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnAtan)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Atn(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnAbs)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Abs(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnRnd)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Rnd(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnLog)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Log(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnLn)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Log(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnLog10)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
'log(10) = 2.30258509299
PushExpression Str$(Log(A) / 2.30258509299), ESP, ExpressionStack()
Case GetOperatorString(rpnInt)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Int(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnFix)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Fix(A)), ESP, ExpressionStack()
Case GetOperatorString(rpnSgn)
Var1 = PopExpression(ESP, ExpressionStack())
A = Val(Var1)
PushExpression Str$(Sgn(A)), ESP, ExpressionStack()
Case Else
'must be an opperand
'when variable and constant support is added,
'it could be added here
'pass the function and array of variables as strings
'i.e Variables(1) might be "x=4.5"
' Variables(2) might be "SigmaZ = 23.55234"
'the code would then go through each each index looking for the
'variable or constant then replace it on the stack
'for now, we'll just push
PushString = TokenString
If ((NumOfVariables <> 0) And (rpnIsNumeric(TokenString) = rpnFalse)) Then
For i = 1 To NumOfVariables
EPosition = InStr(Variables(i), "=")
If EPosition <> 0 Then
If PushString = LCase$(Left$(Variables(i), EPosition - 1)) Then
PushString = Mid$(Variables(i), EPosition + 1)
Exit For
End If
End If
Next i
End If
Select Case TokenString
Case "pi"
PushString = "3.1415926535897932384626433832795028841971693993751"
End Select
PushExpression PushString, ESP, ExpressionStack()
End Select
Loop
EvalPostFix = Val(ExpressionStack(1))
End Function
Function ConvertInfixToPostFix(TExpression As String) As String
Dim OperatorStack(MaxOperators) As Integer
Dim ExpressionStack(MaxExpressions) As String
Dim OSP As Integer
Dim ESP As Integer
Dim TokenString As String
Dim Token As Integer
Dim Position As Integer
Dim Offset As Integer
Dim Length As Integer
Dim Expression As String
Dim VariableBuffer As String
Dim Operator As Integer
Dim ErrorCode As Integer
Dim CheckLeft As String
Dim Counter As Integer
Dim ReturnAnswer As String
Dim TempExpression As String
ErrorCode = rpnFALSE
OSP = 0
ESP = 0
VariableBuffer = ""
Expression = LCase$(TExpression)
Length = Len(Expression)
Offset = 1
Position = 1
TokenString = Left$(Expression, Offset)
'Main loop
Do While (Not ErrorCode) And (Position <= Length)
Operator = rpnFALSE
Offset = 1
Select Case TokenString
Case "+"
Operator = rpnTRUE
Token = rpnPlus
Case "-"
Operator = rpnTRUE
Token = rpnMinus
Case "*"
Operator = rpnTRUE
Token = rpnMultiply
Case "/"
Operator = rpnTRUE
Token = rpnDivide
Case "\"
Operator = rpnTRUE
Token = rpnIntegerDivision
Case "^"
Operator = rpnTRUE
Token = rpnPow
Case "("
Operator = rpnTRUE
Token = rpnLeftParenthesis
Case ")"
Operator = rpnTRUE
Token = rpnRightParenthesis
Case "a"
If Mid$(TExpression, Position, 3) = "atn" Then
Operator = rpnTRUE
Offset = 3
Token = rpnAtan
End If
If Mid$(TExpression, Position, 4) = "atan" Then
Operator = rpnTRUE
Offset = 4
Token = rpnAtan
End If
If Mid$(TExpression, Position, 3) = "abs" Then
Operator = rpnTRUE
Offset = 3
Token = rpnSin
End If
Case "b"
Case "c"
If Mid$(TExpression, Position, 3) = "cos" Then
Operator = rpnTRUE
Offset = 3
Token = rpnCos
End If
Case "e"
If Mid$(TExpression, Position, 3) = "exp" Then
Operator = rpnTRUE
Offset = 3
Token = rpnExp
End If
Case "f"
If Mid$(TExpression, Position, 3) = "fix" Then
Operator = rpnTRUE
Offset = 3
Token = rpnFix
End If
Case "h"
Case "i"
If Mid$(TExpression, Position, 3) = "int" Then
Operator = rpnTRUE
Offset = 3
Token = rpnInt
End If
Case "j"
Case "k"
Case "l"
If Mid$(TExpression, Position, 3) = "log" Then
Operator = rpnTRUE
Offset = 3
Token = rpnLog
End If
If Mid$(TExpression, Position, 2) = "ln" Then
Operator = rpnTRUE
Offset = 2
Token = rpnLn
End If
If Mid$(TExpression, Position, 5) = "log10" Then
Operator = rpnTRUE
Offset = 5
Token = rpnLog10
End If
Case "m"
If Mid$(TExpression, Position, 3) = "mod" Then
Operator = rpnTRUE
Offset = 3
Token = rpnMod
End If
Case "n"
Case "o"
Case "p"
If Mid$(TExpression, Position, 3) = "pow" Then
Operator = rpnTRUE
Offset = 3
Token = rpnPow
End If
Case "q"
Case "r"
If Mid$(TExpression, Position, 3) = "rnd" Then
Operator = rpnTRUE
Offset = 3
Token = rpnRnd
End If
Case "s"
If Mid$(TExpression, Position, 3) = "sin" Then
Operator = rpnTRUE
Offset = 3
Token = rpnSin
End If
If Mid$(TExpression, Position, 3) = "sgn" Then
Operator = rpnTRUE
Offset = 3
Token = rpnSgn
End If
Case "t"
If Mid$(TExpression, Position, 3) = "tan" Then
Operator = rpnTRUE
Offset = 3
Token = rpnTan
End If
Case "u"
Case "v"
Case "w"
Case "x"
Case "y"
Case "z"
Case Else
End Select
If Operator Then
'check + and - to see if they are unary or binary
Select Case Token
Case rpnPlus, rpnMinus
Select Case Position
Case 1
'if its the first character, then it has to be unary
'in that cass just make it part of the variable
VariableBuffer = VariableBuffer + TokenString
Case 2
If Left$(Expression, 1) = "(" Then
'its unary
VariableBuffer = VariableBuffer + TokenString
Else
Update Token, VariableBuffer, OSP, ESP, OperatorStack(), ExpressionStack()
End If
Case Is > 2
'This could be either one
CheckLeft = Mid$(Expression, Position - 2, 2)
If NotOperator(CheckLeft) Then
VariableBuffer = VariableBuffer + TokenString
Else
Update Token, VariableBuffer, OSP, ESP, OperatorStack(), ExpressionStack()
End If
End Select
Case Else
Update Token, VariableBuffer, OSP, ESP, OperatorStack(), ExpressionStack()
End Select
Else
If TokenString <> " " Then VariableBuffer = VariableBuffer + TokenString
End If
Position = Position + Offset
TokenString = Mid$(Expression, Position, 1)
Loop
PushExpression VariableBuffer, ESP, ExpressionStack()
Dim ReturnOperator As Integer
Dim ReturnString As String
Do While OSP <> 0
ReturnOperator = PopOperator(OSP, OperatorStack())
ReturnString = GetOperatorString(ReturnOperator)
PushExpression ReturnString, ESP, ExpressionStack()
Loop
ReturnAnswer = ""
For Counter = 1 To ESP
TempExpression = Trim$(ExpressionStack(Counter))
If TempExpression <> "" Then ReturnAnswer = ReturnAnswer + TempExpression + " "
Next Counter
ConvertInfixToPostFix = ReturnAnswer
End Function
Function PushOperator(ByVal Object As Integer, ByRef StackPointer As Integer, _
Stack() As Integer) As Integer
StackPointer = StackPointer + 1
If StackPointer > MaxOperators Then
PushOperator = rpnFALSE
Else
Stack(StackPointer) = Object
PushOperator = rpnTRUE
End If
End Function
Function PopOperator(ByRef StackPointer As Integer, _
Stack() As Integer) As Integer
If StackPointer = 0 Then
PopOperator = rpnFALSE
Else
PopOperator = Stack(StackPointer)
StackPointer = StackPointer - 1
End If
End Function
Function PushExpression(ByRef Object As String, _
ByRef StackPointer As Integer, _
Stack() As String) As Integer
StackPointer = StackPointer + 1
If StackPointer > MaxExpressions Then
PushExpression = rpnFALSE
Else
Stack(StackPointer) = Object
PushExpression = rpnTRUE
End If
End Function
Function PopExpression(ByRef StackPointer As Integer, _
Stack() As String) As String
If StackPointer = 0 Then
PopExpression = "rpnfalse"
Else
PopExpression = Stack(StackPointer)
StackPointer = StackPointer - 1
End If
End Function
Sub Update(ByVal Operator As Integer, ByRef Expression As String, _
ByRef OSP As Integer, ByRef ESP As Integer, _
OStack() As Integer, EStack() As String)
Dim ReturnPriority As Integer
Dim ReturnAnswer As Integer
Dim ReturnOperator As Integer
Dim ReturnString As String
If Trim$(Expression) <> "" Then ReturnAnswer = PushExpression(Expression, ESP, EStack())
Expression = ""
Select Case Operator
Case rpnLeftParenthesis
ReturnAnswer = PushOperator(Operator, OSP, OStack())
Case rpnRightParenthesis
ReturnOperator = PopOperator(OSP, OStack())
Do While ReturnOperator <> rpnLeftParenthesis
ReturnString = GetOperatorString(ReturnOperator)
PushExpression ReturnString, ESP, EStack()
ReturnOperator = PopOperator(OSP, OStack())
Loop
ReturnOperator = PopOperator(OSP, OStack())
ReturnString = GetOperatorString(ReturnOperator)
PushExpression ReturnString, ESP, EStack()
Case Else
If OSP = 0 Then
PushOperator Operator, OSP, OStack()
Else
ReturnPriority = GetPriority(Operator)
If (ReturnPriority > GetPriority(OStack(OSP))) Then
PushOperator Operator, OSP, OStack()
Else
Do While (ReturnPriority <= GetPriority(OStack(OSP)) And (OSP <> 0))
ReturnOperator = PopOperator(OSP, OStack())
ReturnString = GetOperatorString(ReturnOperator)
PushExpression ReturnString, ESP, EStack()
Loop
PushOperator Operator, OSP, OStack()
End If
End If
End Select
End Sub
Function GetPriority(Operator As Integer) As Integer
Select Case Operator
Case rpnLeftParenthesis
GetPriority = 10
Case rpnPlus, rpnMinus
GetPriority = 30
Case rpnMultiply, rpnDivide, rpnIntegerDivision
GetPriority = 40
Case rpnPow
GetPriority = 50
Case Else
'functions
GetPriority = 60
End Select
End Function
Function NotOperator(Item As String) As Integer
NotOperator = rpnFALSE
Select Case Right$(Item, 1)
Case "+", "-", "*", "/", "\", "(", "^"
NotOperator = rpnTRUE
Case "e"
Select Case Left$(Item, 1)
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "."
NotOperator = rpnTRUE
End Select
End Select
End Function
Function GetOperatorString(Operator As Integer) As String
Select Case Operator
Case rpnLeftParenthesis
GetOperatorString = "("
Case rpnRightParenthesis
GetOperatorString = ")"
Case rpnPlus
GetOperatorString = "+"
Case rpnMinus
GetOperatorString = "-"
Case rpnMultiply
GetOperatorString = "*"
Case rpnDivide
GetOperatorString = "/"
Case rpnPercent
GetOperatorString = "%"
Case rpnIntegerDivision
GetOperatorString = "\"
Case rpnPow, rpnExp
GetOperatorString = "^"
Case rpnAbs
GetOperatorString = "ABS"
Case rpnAtan
GetOperatorString = "ATAN"
Case rpnCos
GetOperatorString = "COS"
Case rpnSin
GetOperatorString = "SIN"
Case rpnExp
GetOperatorString = "^"
Case rpnFix
GetOperatorString = "FIX"
Case rpnInt
GetOperatorString = "INT"
Case rpnLn
GetOperatorString = "LN"
Case rpnLog
GetOperatorString = "LOG"
Case rpnRnd
GetOperatorString = "RND"
Case rpnSgn
GetOperatorString = "SGN"
Case rpnSqr
GetOperatorString = "SQR"
Case rpnTan
GetOperatorString = "TAN"
Case rpnAcos
GetOperatorString = "ACOS"
Case rpnAsin
GetOperatorString = "ASIN"
Case rpnCosh
GetOperatorString = "COSH"
Case rpnSinh
GetOperatorString = "SINH"
Case rpnTanh
GetOperatorString = "TANH"
Case rpnAcosh
GetOperatorString = "ACOSH"
Case rpnAsinh
GetOperatorString = "ASINH"
Case rpnAtanh
GetOperatorString = "ATANH"
Case rpnMod
GetOperatorString = "MOD"
Case rpnFact
GetOperatorString = "FACT"
Case rpnNeg
GetOperatorString = "NEG"
Case rpnLog10
GetOperatorString = "LOG10"
Case Else
GetOperatorString = "ERROR"
End Select
End Function
Function FindVariables(PostFix As String, VariableArray() As String) As Integer
Dim Position As Integer
Dim TokenString As String
Dim WorkingString As String
Dim IsOp As Integer
Dim i As Integer
dim ReturnAnswer as integer
dim NewVariable as integer
WorkingString = PostFix
Position = InStr(WorkingString, " ")
ReturnAnswer = 0
Do While (Position <> 0)
TokenString = Left$(WorkingString, Position - 1)
WorkingString = Mid$(WorkingString, Position + 1)
Position = InStr(WorkingString, " ")
If rpnIsNumeric(TokenString) = rpnFalse Then
IsOp = rpnFALSE
For i = 1 To CurrentNumberOfOperators
If TokenString = GetOperatorString(i) Then
IsOp = rpnTRUE
Exit For
End If
Next i
If IsOp = rpnFALSE Then
Select Case LCase$(TokenString)
Case "pi"
'do nothing, just check if its a constant that is defined
Case Else
NewVariable = rpnTrue
for i = 1 to returnanswer
if tokenstring + "=" = VariableArray(i) then
NewVariable = rpnFalse
exit for
end if
next i
if NewVariable = rpnTrue then
'it has to be a new variable
ReturnAnswer = ReturnAnswer + 1
VariableArray(ReturnAnswer) = TokenString + "="
end if
End Select
End If
End If
Loop
FindVariables = ReturnAnswer
End Function
Sub DefineVariables(NumOfVariables As Integer, VariableList() As String)
Dim i As Integer
Dim ReturnAnswer As String
For i = 1 To NumOfVariables
? VariableList(i);
input$ ReturnAnswer
VariableList(i) = VariableList(i) + Trim$(ReturnAnswer)
Next i
End Sub
function rpnIsNumeric(ValString as string) as integer
Dim DecimalCount as integer
dim MinusCount as integer
dim PlusCount as integer
Dim ECount as integer
Dim IsNumericCounter as integer
Dim Length As Integer
dim CheckCharacter as String
DecimalCount=0
MinusCount=0
PlusCount=0
ECount=0
Length = len(ValString)
For IsNumericCounter = 1 to Length
CheckCharacter = mid$(ValString,IsNumericCounter,1)
select case CheckCharacter
case "0","1","2","3","4","5","6","7","8","9"
'we are fine with these, go on to something else
case "."
DecimalCount = DecimalCount + 1
'There can be only one!
if DecimalCount>1 then
rpnIsNumeric=rpnFALSE
exit function
end if
if ECount<>0 then
rpnIsNumeric=rpnFALSE
exit function
end if
case "+"
PlusCount = PlusCount + 1
if (((IsNumericCounter<>1) and (ECount=0)) or (PlusCount>2)) then
rpnIsNumeric=rpnFALSE
exit function
end if
if (IsNumericCounter<>1) then
if lcase$(mid$(ValString,IsNumericCounter-1,1))<>"e" then
rpnIsNumeric=rpnFALSE
exit function
end if
end if
case "-"
MinusCount = MinusCount + 1
if (((IsNumericCounter<>1) and (ECount=0)) or (MinusCount>2)) then
rpnIsNumeric=rpnFALSE
exit function
end if
if (IsNumericCounter<>1) then
if lcase$(mid$(ValString,IsNumericCounter-1,1))<>"e" then
rpnIsNumeric=rpnFALSE
exit function
end if
end if
case "e","E"
ECount=ECount+1
if (IsNumericCounter=1) or (ECount>1) then
rpnIsNumeric=rpnFALSE
exit function
end if
if (mid$(ValString,IsNumericCounter-1,1))="+" or _
(mid$(ValString,IsNumericCounter-1,1))="-" then
rpnIsNumeric=rpnFALSE
exit function
end if
case Else
rpnIsNumeric=rpnFALSE
exit function
end select
next IsNumericCounter
rpnIsNumeric = rpnTRUE
END FUNCTION
Maybe something for the math library... a WIP Math Parser! - jdebord - 03-05-2005
Thank you very much. I am checking it with FB 0.12b. I will post more comments later.
Maybe something for the math library... a WIP Math Parser! - gbos - 03-06-2005
There are working parsers developed in bcx and rapidq. For example this is the core for a bcx parser. I think they can be translated into FB relatively easy.
Code: ' Evaluating a simple string 2+3*5+2^2 and returns a string with the answer
' else it returns "Division by zero!"
Function EvaluateTheString2$(pass$)
Dim a#[100]
Dim ap%[100]
Dim TheString$
TheString$=pass$
if LEN(TheString$)=0 then
FUNCTION="0"
End if
TheString$=LCase$(TheString$)
TheString$="+"&TheString$
TheString$= REPLACE$(TheString$," ","")
TheString$= REPLACE$(TheString$,"++","+")
TheString$= REPLACE$(TheString$,"-+","-")
TheString$= REPLACE$(TheString$,"--","+")
' add these to follow excel notation
TheString$= REPLACE$(TheString$,"/-","/+-")
TheString$= REPLACE$(TheString$,"*-","*+-")
TheString$= REPLACE$(TheString$,"^-","^+-")
'TheString$= REPLACE$(TheString$,"+-","-")
Dim i%,x%,dx%,ct%,j%,maxi%
Dim e$
Dim s#
i%=0
maxi%=0
x%=0
s#=0
do
x%=x%+1
e$=mid$(TheString$,x%,1)
if LEN(e$)=0 then exit do
if e$="0" or e$="1" or e$="2" or e$="3" or e$="4" or e$="5" or e$="6" or e$="7" or e$="8" or e$="9" or e$="." then
dx%=0
do
dx%=dx%+1
e$=mid$(TheString,x%+dx%,1)
if ((e$="+" or e$="-") and (mid$(TheString$,x%+dx%-1,1)<>"e")) or e$="^" or e$="*" or e$="/" or LEN(e$)=0 then
i%=i%+1
a#[i%]=val(mid$(TheString$,x%,dx%))
exit do
end if
loop
x%=x%+dx%
end if
if e$="+" then
dx%=0
do
dx%=dx%+1
e$=mid$(TheString$,x%+dx%,1)
if ((e$="+" or (e$="-" and dx%<>1)) and mid$(TheString$,x%+dx%-1,1)<>"e") or e$="^" or e$="*" or e$="/" or LEN(e$)=0 then
i%=i%+1
a#[i%]=val(mid$(TheString,x%+1,dx%-1))
exit do
end if
loop
x%=x%+dx%-1
end if
'if i%=0 and e$="-" then
'a#[1]=0
'i%=1
'end if
if e$="^" then ap%[i%]=3
if e$="*" then ap%[i%]=2
if e$="/" then ap%[i%]=1
if e$="-" then 'ap(i)=ap(i)+4
if ap%[i%]=3 then ap%[i%]=7
if ap%[i%]=2 then ap%[i%]=6
if ap%[i%]=1 then ap%[i%]=5
if ap%[i%]=4 then ap%[i%]=0
if ap%[i%]=0 then ap%[i%]=4
end if
loop
maxi%=i%
'calculate "^"
ct%=0
do
ct%=ct%+1
if ct%=i% then exit do
if ap%[ct%]=3 then
a#[ct%]=a#[ct%]^a#[ct%+1]
for j%=ct%+1 to i%-1
a#[j%]=a#[j%+1]
ap%[j%-1]=ap%[j%]
next j%
i%=i%-1
ct%=0
end if
if ap%[ct%]=7 then
a#[ct%]=a#[ct%]^(-a#[ct%+1])
for j%=ct%+1 to i%-1
a#[j%]=a#[j%+1]
ap%[j%-1]=ap%[j%]
next j%
i%=i%-1
ct%=0
end if
loop
'calculate "*" & "/"
ct%=0
do
ct%=ct%+1
if ct%=i then exit do
if ap%[ct%]=2 then
a#[ct%]=a#[ct%]*a#[ct%+1]
for j%=ct%+1 to i%-1
a#[j%]=a#[j%+1]
ap%[j%-1]=ap%[j%]
next j%
i%=i%-1
ct%=0
end if
if ap%[ct%]=6 then
a#[ct%]=a#[ct%]*(-a#[ct%+1])
for j%=ct%+1 to i%-1
a#[j%]=a#[j%+1]
ap%[j%-1]=ap%[j%]
next j%
i%=i%-1
ct%=0
end if
if ap%[ct%]=1 then
if a#[ct%+1]=0 then
'Division by zero!
'TheError=1
function="Division by zero!"
End if
a#[ct%]=a#[ct%]/a#[ct%+1]
for j%=ct%+1 to i%-1
a#[j%]=a#[j%+1]
ap%[j%-1]=ap%[j%]
next j%
i%=i%-1
ct%=0
end if
if ap%[ct%]=5 then
if a#[ct%+1]=0 then
'Division by zero!
'TheError=1
function="Division by zero!"
End if
a#[ct%]=a#[ct%]/(-a#[ct%+1])
for j%=ct%+1 to i%-1
a#[j%]=a#[j%+1]
ap%[j%-1]=ap%[j%]
next j%
i%=i%-1
ct%=0
end if
loop
for ct%=2 to i%
if ap%[ct%-1]=0 then
s#=s#+a#[ct%]
else
s#=s#-a#[ct%]
end if
next ct%
s#=s#+a#[1]
FUNCTION=str$(s#)
End Function
Maybe something for the math library... a WIP Math Parser! - marzecTM - 03-06-2005
does this parser only evaluate numeric expressions? or should it also be able to handle derivation of functions etc.?
Maybe something for the math library... a WIP Math Parser! - keeling - 03-06-2005
A derivation would be done with routines.... which are easy to do for numerical derivations.
A parser just gives the program access to a user input function.
If you are looking for numerical integration and derivation I can work up some in very short order.
Maybe something for the math library... a WIP Math Parser! - keeling - 03-06-2005
I have seen code like this but it (the BCX you posted) works, and would be easy to translate, but it doesn't handle functions, variables, or mathematical constants.... mine does (or will)... I haven't crashed it in moderate use yet, but if someone does find something in mine please let me know.
Mine is just another version... use what you like.
Maybe something for the math library... a WIP Math Parser! - marzecTM - 03-06-2005
uhm, i didn't read your first post properly and hacked a parser for math expressions myself. well it's not stack/postfix based but a recursive decent parser. maybe you can use it, i guess it's easier to extend it, here's the code ( sorry was to lazy to upload it )
Code: '------------------------------------------------------------------------------
' Math Expression Parser
'
' file: mathparse.bas
'
' desc: this thingy takes a string that contains a math expression and
' returns the result the expression as a string. errors are indicated
' with a returnvalue of 0 and the string gets filled with the error
' description.
'
' the parser follows this ebnf grammar
'
' addexpr := mulexpr ( ( + | - ) mulexpr )*
'
'
' mulexp := negexp ( ( '*' | '/' ) negexp )*
'
'
' negexp := ('-' | '+') expexpr
' | expexpr
'
'
' expexpr := atom ( ^ atom )*
'
' funcexpr := 'cos' '(' addexpr ')'
' | 'sin' '(' addexpr ')'
' | paraexpr
'
' paraexp := '(' addexpr ')'
' | atom
'
' atom := NUMBER
'
'
' the module is really composed of 2 modules, one that lexes the string
' and the other parses and returns the result. if you want more functions
' then simply extend parFuncExpr and follow the sin/cos examples there.
' you'll also have to extend the lex function so that it recognizes
' your keyword for your function ( see the last code block there, take
' cos sin as an example again). Note that function names can only be composed
' of the letters a - z
'
'
' currently supported operators and function:
' -------------------------------------------
'
' + - addition, substraction
' * / multiplication, division
' - + unary sign
' ^ power ( also fractions allowed )
' cos( expr ) cosinus of the expression in radians
' sin( expr ) sinus of the expression in radians
' ( ) paranthesis to group expressions
'
' all numbers are handled as double, fractions are seperated with a dot '.'
' if you have several dots within a number then the fraction after the
' second dot is ignored.
'
' to use this in your own programms just declare mathParser and mathParserGetErrorMsg
' like this
'
' declare function mathParser( mathexpr as string, result as string) as integer
' declare function mathParserGetErrorMsg( ) as string
'
' simply pass your math expression string to mathParser, it will return 0 on failure
' and -1 on success, and stores the result in the passed result string. if there
' was an error you can call mathParserGetErrorMsg to get a descriptive error message
'
'
'------------------------------------------------------------------------------
option explicit
declare function parAddExpr( ) as double
declare function parMulExpr( ) as double
declare function parNegExpr( ) as double
declare function parExpExpr( ) as double
declare function parFuncExpr( ) as double
declare function parParaExpr( ) as double
declare function parAtom( ) as double
enum TokenType
TOKEN.TYPE.ADD
TOKEN.TYPE.SUB
TOKEN.TYPE.DIV
TOKEN.TYPE.MUL
TOKEN.TYPE.LPARA
TOKEN.TYPE.RPARA
TOKEN.TYPE.POW
TOKEN.TYPE.NUMBER
TOKEN.TYPE.COS
TOKEN.TYPE.SIN
TOKEN.TYPE.EOS
TOKEN.TYPE.UNKNOWN
end enum
type token
type_ as TokenType
value as double
end type
type LexerCtx
curr_char as byte ptr
token as Token
end type
dim shared lexer as LexerCtx
dim shared tmp_str as string ' this here is a bad bad hack, no dyn strings in udts
' so we have to store that here...
function LexerInit ( mathexpr as string ) as integer
tmp_str = mathexpr
lexer.curr_char = sadd(tmp_str)
end function
sub lex( )
dim tmp_number as string
lexer.token.type_ = TOKEN.TYPE.UNKNOWN
lexer.token.value = 0.0
'' check for whitespaces and loop over them
while( *lexer.curr_char = asc(" ") or *lexer.curr_char = 9 )
lexer.curr_char += 1
wend
'' EOS
if( *lexer.curr_char = 0 ) then
lexer.token.type_ = TOKEN.TYPE.EOS
lexer.token.value = 0.0
exit sub
end if
'' found a number let's lex it
if( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) then
tmp_number = chr$(*lexer.curr_char)
lexer.curr_char += 1
while( ( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) or *lexer.curr_char= ASC(".") )
tmp_number += chr$(*lexer.curr_char)
lexer.curr_char += 1
wend
lexer.token.type_ = TOKEN.TYPE.NUMBER
lexer.token.value = val(tmp_number)
exit sub
end if
'' otherwise it must be one of the operators ( '(', ')', '*', '/', '+', '-', '^' )
select case *lexer.curr_char
case asc("("):
lexer.token.type_ = TOKEN.TYPE.LPARA
case asc(")"):
lexer.token.type_ = TOKEN.TYPE.RPARA
case asc("*"):
lexer.token.type_ = TOKEN.TYPE.MUL
case asc("/"):
lexer.token.type_ = TOKEN.TYPE.DIV
case asc("+"):
lexer.token.type_ = TOKEN.TYPE.ADD
case asc("-"):
lexer.token.type_ = TOKEN.TYPE.SUB
case asc("^"):
lexer.token.type_ = TOKEN.TYPE.POW
end select
if( lexer.token.type_ <> TOKEN.TYPE.UNKNOWN ) then
lexer.curr_char += 1
exit sub
end if
'' otherwise we check wheter we got a keyword
dim keyword as string
while( (*lexer.curr_char <> asc(" ") and *lexer.curr_char <> 9 and *lexer.curr_char <> 0) and _
(lcase$(*lexer.curr_char) >= "a" and lcase$(*lexer.curr_char) <= "z" ) )
keyword += chr$(*lexer.curr_char)
lexer.curr_char += 1
wend
select case UCASE$(keyword)
case "SIN":
lexer.token.type_ = TOKEN.TYPE.SIN
case "COS":
lexer.token.type_ = TOKEN.TYPE.COS
end select
end sub
sub lexerTest()
dim mathexpr as string
line input "mathexpression:", mathexpr
LexerInit mathexpr
leX()
while( lexer.token.type_ <> TOKEN.TYPE.EOS and lexer.token.type_ <> TOKEN.TYPE.UNKNOWN )
select case lexer.token.type_
case TOKEN.TYPE.ADD:
print "TOKEN.TYPE.ADD ";
case TOKEN.TYPE.SUB:
print "TOKEN.TYPE.SUB ";
case TOKEN.TYPE.MUL:
print "TOKEN.TYPE.MUL ";
case TOKEN.TYPE.DIV:
print "TOKEN.TYPE.DIV ";
case TOKEN.TYPE.POW:
print "TOKEN.TYPE.POW ";
case TOKEN.TYPE.LPARA:
print "TOKEN.TYPE.LPARA ";
case TOKEN.TYPE.RPARA:
print "TOKEN.TYPE.RPARA ";
case TOKEN.TYPE.NUMBER:
print str$( lexer.token.value ) + " ";
end select
lex()
wend
if( lexer.token.type_ = TOKEN.TYPE.EOS ) then
print " TOKEN.TYPE.EOS "
else
print " TOKEN.TYPE.UNKNOWN "
end if
end sub
dim shared Parser.error as integer
dim shared Parser.errormsg as string
function mathParsergetErrorMsg() as string
mathParserGetErrorMsg = Parser.errormsg
end function
function mathParser ( mathexpr as string, result as string) as integer
dim res as double
LexerInit mathexpr
Parser.error = 0
Parser.errormsg = ""
lex()
res = parAddExpr()
result = str$(res)
if( Parser.error ) then
mathParser = 0
exit function
else
mathParser = -1
exit function
end if
end function
function parAddExpr ( ) as double
dim value1 as double
dim value2 as double
dim optype as TokenType
'' get the left sided value
value1 = parMulExpr( )
if( Parser.error ) then exit function
'' do we have a valid operator ( +, - )?
if( lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB ) then
while(lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB )
optype = lexer.token.type_
lex()
value2 = parMulExpr()
if( Parser.error ) then exit function
if( optype = TOKEN.TYPE.ADD ) then
value1 += value2
elseif( optype = TOKEN.TYPE.SUB ) then
value1 -= value2
end if
wend
end if
parAddExpr = value1
end function
function parMulExpr ( ) as double
dim value1 as double
dim value2 as double
dim optype as TokenType
'' get the left sided value
value1 = parNegExpr( )
if( Parser.error ) then exit function
'' do we have a valid operator ( *, / )?
if( lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV ) then
while(lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV )
optype = lexer.token.type_
lex()
value2 = parNegExpr()
if( Parser.error ) then exit function
if( optype = TOKEN.TYPE.MUL ) then
value1 *= value2
elseif( optype = TOKEN.TYPE.DIV ) then
if( value2 = 0.0 ) then
Parser.error = -1
Parser.errormsg = "error: division by zero"
exit function
else
value1 /= value2
end if
end if
wend
end if
parMulExpr = value1
end function
function parNegExpr ( ) as double
if( lexer.token.type_ = TOKEN.TYPE.SUB ) THEN
lex()
parNegExpr = parExpExpr()
elseif ( lexer.token.type_ = TOKEN.TYPE.ADD ) then
lex()
parNegExpr = parExpExpr()
else
parNegExpr = parExpExpr()
end if
end function
function parExpExpr ( ) as double
dim value1 as double
dim value2 as double
dim optype as TokenType
'' get the left sided value
value1 = parFuncExpr( )
if( Parser.error ) then exit function
'' do we have a valid operator ( *, / )?
if( lexer.token.type_ = TOKEN.TYPE.POW ) then
while(lexer.token.type_ = TOKEN.TYPE.POW )
optype = lexer.token.type_
lex()
value2 = parFuncExpr()
if( Parser.error ) then exit function
value1 = value1 ^ value2
wend
end if
parExpExpr = value1
end function
function parFuncExpr ( ) as double
select case lexer.token.type_
case TOKEN.TYPE.SIN:
lex()
parFuncExpr = sin( parParaExpr )
case TOKEN.TYPE.COS:
lex()
parFuncExpr = cos( parParaExpr )
case else
parFuncExpr = parParaExpr()
end select
end function
function parParaExpr ( ) as double
if( lexer.token.type_ = TOKEN.TYPE.LPARA ) then
lex()
parParaExpr = parAddExpr()
if( Parser.error = -1 ) then exit function
if( lexer.token.type_ <> TOKEN.TYPE.RPARA ) then
Parser.error = -1
Parser.errormsg = "error: expected ')'"
print "paraexpr: " + str$(lexer.token.type_)
exit function
end if
lex()
else
parParaExpr = parAtom()
end if
end function
function parAtom ( ) as double
if( lexer.token.type_ <> TOKEN.TYPE.NUMBER ) then
Parser.error = -1
Parser.errormsg = "error: expected number"
else
parAtom = lexer.token.value
lex()
end if
end function
dim mathexpr as string
dim result as string
line input "enter math expression:" , mathexpr
if( mathParser( mathexpr, result ) = 0 ) then
print mathParserGetErrorMsg()
else
print "result is:" + result
end if
Maybe something for the math library... a WIP Math Parser! - gbos - 03-06-2005
marzecTM a small bug
-(-1^2) should return -1 and not 1.
Maybe something for the math library... a WIP Math Parser! - marzecTM - 03-06-2005
hm, that is the result of the priorities used. power has bigger priority as the unary -. fb has the same behaviour, that is the same priorities. i could change that to the reverse order. for now if you want the power of a negativ number you have to enclose this number in paranthesis. e.g.:
-((-1)^2)
i found another bug though so here's the last version of it
Code: '------------------------------------------------------------------------------
' Math Expression Parser
'
' file: mathparse.bas
'
' desc: this thingy takes a string that contains a math expression and
' returns the result the expression as a string. errors are indicated
' with a returnvalue of 0 and the string gets filled with the error
' description.
'
' the parser follows this ebnf grammar
'
' addexpr := mulexpr ( ( + | - ) mulexpr )*
'
'
' mulexp := negexp ( ( '*' | '/' ) negexp )*
'
'
' negexp := ('-' | '+') expexpr
' | expexpr
'
'
' expexpr := atom ( ^ atom )*
'
' funcexpr := 'cos' '(' addexpr ')'
' | 'sin' '(' addexpr ')'
' | paraexpr
'
' paraexp := '(' addexpr ')'
' | atom
'
' atom := NUMBER
'
'
' the module is really composed of 2 modules, one that lexes the string
' and the other parses and returns the result. if you want more functions
' then simply extend parFuncExpr and follow the sin/cos examples there.
' you'll also have to extend the lex function so that it recognizes
' your keyword for your function ( see the last code block there, take
' cos sin as an example again). Note that function names can only be composed
' of the letters a - z
'
'
' currently supported operators and function:
' -------------------------------------------
'
' + - addition, substraction
' * / multiplication, division
' - + unary sign
' ^ power ( also fractions allowed )
' cos( expr ) cosinus of the expression in radians
' sin( expr ) sinus of the expression in radians
' ( ) paranthesis to group expressions
'
' all numbers are handled as double, fractions are seperated with a dot '.'
' if you have several dots within a number then the fraction after the
' second dot is ignored.
'
' to use this in your own programms just declare mathParser and mathParserGetErrorMsg
' like this
'
' declare function mathParser( mathexpr as string, result as string) as integer
' declare function mathParserGetErrorMsg( ) as string
'
' simply pass your math expression string to mathParser, it will return 0 on failure
' and -1 on success, and stores the result in the passed result string. if there
' was an error you can call mathParserGetErrorMsg to get a descriptive error message
'
'
'------------------------------------------------------------------------------
option explicit
declare function parAddExpr( ) as double
declare function parMulExpr( ) as double
declare function parNegExpr( ) as double
declare function parExpExpr( ) as double
declare function parFuncExpr( ) as double
declare function parParaExpr( ) as double
declare function parAtom( ) as double
enum TokenType
TOKEN.TYPE.ADD
TOKEN.TYPE.SUB
TOKEN.TYPE.DIV
TOKEN.TYPE.MUL
TOKEN.TYPE.LPARA
TOKEN.TYPE.RPARA
TOKEN.TYPE.POW
TOKEN.TYPE.NUMBER
TOKEN.TYPE.COS
TOKEN.TYPE.SIN
TOKEN.TYPE.EOS
TOKEN.TYPE.UNKNOWN
end enum
type token
type_ as TokenType
value as double
end type
type LexerCtx
curr_char as byte ptr
token as Token
end type
dim shared lexer as LexerCtx
dim shared tmp_str as string ' this here is a bad bad hack, no dyn strings in udts
' so we have to store that here...
function LexerInit ( mathexpr as string ) as integer
tmp_str = mathexpr
lexer.curr_char = sadd(tmp_str)
end function
sub lex( )
dim tmp_number as string
lexer.token.type_ = TOKEN.TYPE.UNKNOWN
lexer.token.value = 0.0
'' check for whitespaces and loop over them
while( *lexer.curr_char = asc(" ") or *lexer.curr_char = 9 )
lexer.curr_char += 1
wend
'' EOS
if( *lexer.curr_char = 0 ) then
lexer.token.type_ = TOKEN.TYPE.EOS
lexer.token.value = 0.0
exit sub
end if
'' found a number let's lex it
if( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) then
tmp_number = chr$(*lexer.curr_char)
lexer.curr_char += 1
while( ( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) or *lexer.curr_char= ASC(".") )
tmp_number += chr$(*lexer.curr_char)
lexer.curr_char += 1
wend
lexer.token.type_ = TOKEN.TYPE.NUMBER
lexer.token.value = val(tmp_number)
exit sub
end if
'' otherwise it must be one of the operators ( '(', ')', '*', '/', '+', '-', '^' )
select case *lexer.curr_char
case asc("("):
lexer.token.type_ = TOKEN.TYPE.LPARA
case asc(")"):
lexer.token.type_ = TOKEN.TYPE.RPARA
case asc("*"):
lexer.token.type_ = TOKEN.TYPE.MUL
case asc("/"):
lexer.token.type_ = TOKEN.TYPE.DIV
case asc("+"):
lexer.token.type_ = TOKEN.TYPE.ADD
case asc("-"):
lexer.token.type_ = TOKEN.TYPE.SUB
case asc("^"):
lexer.token.type_ = TOKEN.TYPE.POW
end select
if( lexer.token.type_ <> TOKEN.TYPE.UNKNOWN ) then
lexer.curr_char += 1
exit sub
end if
'' otherwise we check wheter we got a keyword
dim keyword as string
while( (*lexer.curr_char <> asc(" ") and *lexer.curr_char <> 9 and *lexer.curr_char <> 0) and _
(lcase$(*lexer.curr_char) >= "a" and lcase$(*lexer.curr_char) <= "z" ) )
keyword += chr$(*lexer.curr_char)
lexer.curr_char += 1
wend
select case UCASE$(keyword)
case "SIN":
lexer.token.type_ = TOKEN.TYPE.SIN
case "COS":
lexer.token.type_ = TOKEN.TYPE.COS
end select
end sub
sub lexerTest()
dim mathexpr as string
line input "mathexpression:", mathexpr
LexerInit mathexpr
leX()
while( lexer.token.type_ <> TOKEN.TYPE.EOS and lexer.token.type_ <> TOKEN.TYPE.UNKNOWN )
select case lexer.token.type_
case TOKEN.TYPE.ADD:
print "TOKEN.TYPE.ADD ";
case TOKEN.TYPE.SUB:
print "TOKEN.TYPE.SUB ";
case TOKEN.TYPE.MUL:
print "TOKEN.TYPE.MUL ";
case TOKEN.TYPE.DIV:
print "TOKEN.TYPE.DIV ";
case TOKEN.TYPE.POW:
print "TOKEN.TYPE.POW ";
case TOKEN.TYPE.LPARA:
print "TOKEN.TYPE.LPARA ";
case TOKEN.TYPE.RPARA:
print "TOKEN.TYPE.RPARA ";
case TOKEN.TYPE.NUMBER:
print str$( lexer.token.value ) + " ";
end select
lex()
wend
if( lexer.token.type_ = TOKEN.TYPE.EOS ) then
print " TOKEN.TYPE.EOS "
else
print " TOKEN.TYPE.UNKNOWN "
end if
end sub
dim shared Parser.error as integer
dim shared Parser.errormsg as string
function mathParsergetErrorMsg() as string
mathParserGetErrorMsg = Parser.errormsg
end function
function mathParser ( mathexpr as string, result as string) as integer
dim res as double
LexerInit mathexpr
Parser.error = 0
Parser.errormsg = ""
lex()
res = parAddExpr()
result = str$(res)
if( Parser.error ) then
mathParser = 0
exit function
else
mathParser = -1
exit function
end if
end function
function parAddExpr ( ) as double
dim value1 as double
dim value2 as double
dim optype as TokenType
'' get the left sided value
value1 = parMulExpr( )
if( Parser.error ) then exit function
'' do we have a valid operator ( +, - )?
if( lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB ) then
while(lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB )
optype = lexer.token.type_
lex()
value2 = parMulExpr()
if( Parser.error ) then exit function
if( optype = TOKEN.TYPE.ADD ) then
value1 += value2
elseif( optype = TOKEN.TYPE.SUB ) then
value1 -= value2
end if
wend
end if
parAddExpr = value1
end function
function parMulExpr ( ) as double
dim value1 as double
dim value2 as double
dim optype as TokenType
'' get the left sided value
value1 = parNegExpr( )
if( Parser.error ) then exit function
'' do we have a valid operator ( *, / )?
if( lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV ) then
while(lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV )
optype = lexer.token.type_
lex()
value2 = parNegExpr()
if( Parser.error ) then exit function
if( optype = TOKEN.TYPE.MUL ) then
value1 *= value2
elseif( optype = TOKEN.TYPE.DIV ) then
if( value2 = 0.0 ) then
Parser.error = -1
Parser.errormsg = "error: division by zero"
exit function
else
value1 /= value2
end if
end if
wend
end if
parMulExpr = value1
end function
function parNegExpr ( ) as double
if( lexer.token.type_ = TOKEN.TYPE.SUB ) THEN
lex()
parNegExpr = -parExpExpr()
elseif ( lexer.token.type_ = TOKEN.TYPE.ADD ) then
lex()
parNegExpr = parExpExpr()
else
parNegExpr = parExpExpr()
end if
end function
function parExpExpr ( ) as double
dim value1 as double
dim value2 as double
dim optype as TokenType
'' get the left sided value
value1 = parFuncExpr( )
if( Parser.error ) then exit function
'' do we have a valid operator ( *, / )?
if( lexer.token.type_ = TOKEN.TYPE.POW ) then
while(lexer.token.type_ = TOKEN.TYPE.POW )
optype = lexer.token.type_
lex()
value2 = parFuncExpr()
if( Parser.error ) then exit function
value1 = value1 ^ value2
wend
end if
parExpExpr = value1
end function
function parFuncExpr ( ) as double
select case lexer.token.type_
case TOKEN.TYPE.SIN:
lex()
parFuncExpr = sin( parParaExpr )
case TOKEN.TYPE.COS:
lex()
parFuncExpr = cos( parParaExpr )
case else
parFuncExpr = parParaExpr()
end select
end function
function parParaExpr ( ) as double
dim value as double
if( lexer.token.type_ = TOKEN.TYPE.LPARA ) then
lex()
value = parAddExpr()
parParaExpr = value
if( Parser.error = -1 ) then exit function
if( lexer.token.type_ <> TOKEN.TYPE.RPARA ) then
Parser.error = -1
Parser.errormsg = "error: expected ')'"
print "paraexpr: " + str$(lexer.token.type_)
exit function
end if
lex()
else
parParaExpr = parAtom()
end if
end function
function parAtom ( ) as double
if( lexer.token.type_ <> TOKEN.TYPE.NUMBER ) then
Parser.error = -1
Parser.errormsg = "error: expected number"
else
parAtom = lexer.token.value
lex()
end if
end function
dim mathexpr as string
dim result as string
line input "enter math expression:" , mathexpr
if( mathParser( mathexpr, result ) = 0 ) then
print mathParserGetErrorMsg()
else
print "result is:" + result
end if
Maybe something for the math library... a WIP Math Parser! - jdebord - 03-06-2005
I have tried to evaluate:
sin(0.1)^2 + cos(0.1)^2
This expression is accepted by marzecTM's parser (and is of course evaluated to 1), but with keeling's parser, I had to enter:
((sin(0.1))^2)+((cos(0.1)^2)
Is there a means to get rid of the extra parentheses ?
|