Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Maybe something for the math library... a WIP Math Parser!
#1
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. Smile

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
Reply


Messages In This Thread
Maybe something for the math library... a WIP Math Parser! - by keeling - 03-05-2005, 12:07 AM

Forum Jump:


Users browsing this thread: 1 Guest(s)