1.11M Members

Math Parser and Evaluator Programming Overview Tutorial

 
-2
 

Have you ever wanted to develop a math parser and evaluator? Are you in such a quandary or just have curiosity or interest in the matter? If so, you may download the complete source version 8.3.48 or later, but be warned there is almost no comment; or instead, follow versions v8.4.x which will be more digest and, of course, all the source code for each new v8.4.x will be there, if you wish, to download.
Currently, v8.4.0 does simple arithmetic but contains the main classes and algorithms that hold all the rest.
Version 8.4.0 has been developed entirely under MS Visual Studio Express 2013 for Windows Desktop and, surely, in future releases.
In the downloadable example you may find Form1 having 2 textboxes: tbInput and tbOuput, one button and a label to show eventual messages: btnCalculate and lblMessage.

When running, user types for example "3+4/2" (without quotes) in tbInput and clicks the "Calculate" button, so btnCalculate_Click() is executed and, in turn, the Calculate() method.
There, the shared method exprParser.Parse is called passing the input string as parameter.
If everything goes right, there will be no error, eP.retErr will be 'Nothing' and eP.retVal will have the result.
If not, eP.retErr.ToString contains the error message.
In the example, the ouput would be 5.
On the contrary, an incomplete "3+4/" would show the corresponding error message.
Note: simple arithmetic of only numbers and operators give the expected result, at the moment.

Public Class Form1

    Private Sub btnCalculate_Click(sender As Object, e As EventArgs) Handles btnCalculate.Click
        Calculate()
    End Sub

    Sub Calculate()
        Try
            Dim eP As exprParser = exprParser.Parse(tbInput.Text)
            If eP.retErr IsNot Nothing Then
                ' Show error message:
                lblMessage.Text = eP.retErr.ToString
                tbOutput.Text = ""
            Else
                ' Show the result:
                tbOutput.Text = eP.retVal.ToString
                lblMessage.Text = ""
            End If
        Catch ex As Exception
            MessageBox.Show("Unexpected error:" + vbCrLf + ex.Message)
        End Try
    End Sub
End Class

You may find the afore mentioned here.

 
1
 

While this may show how to use the classes you have developed I think it falls far short of a Daniweb tutorial because it doesn't actually teach anything. First of all, the code appears elsewhere which means we have to rely on the content always being available on an external (to Daniweb) server. Next, there is an almost complete lack of comments.

You started out by stating

Have you ever wanted to develop a math parser and evaluator?

At best what you have provided is a black box with an example of how to call it.

 
0
 

I see, in a short term, I'll provide Daniweb an extense explanation.

 
0
 

Here is the explanation, along with a VB.Net module.
There are four consecutive functions. Each one invokes the next and, on exit, returns back to the previous function the result. Namely:
1. expression() performs "+" and "-" operations
2. term() performs "" and "/" operations
3. pow() performs "^","%" and "!" operations
function expression() calls term()
function term() calls pow()
function pow() calls token()
Then token() returns back the first operand, after setting the current caracter behind the operand, so pointing to the first operator. In case of a "+" or "-" operator (as in "2+3"), the execution will return back to expression, receiving the first operand value and then calling back to term() for the second operand. In a similar way, term() will call pow(), pow() will call token() and, then return, all the way up, to expression. There, operation "+" or "-" will take place.
In case there is another operator after the second operator, for instance a "
" in "2+34", in the middle of the way up, from token() to expression(), function term() will find that must perform current operator "". So before the addition, term() will call pow() asking for the second operand. This will be a "4", "3*4" will be calculated and return back to expression() his second operand equal to 12 and add to the first 2.
When token() founds a "(" calls, recursively, to expression(). Expression() will return back to token() the result of the arithmetic inside the parentheses.

Module Module1

    Dim str As String
    Dim line As String
    Dim curChar As Int32
    Dim oper_AD As String = "+-"
    Dim oper_MUL As String = "*/"
    Dim oper_POW As String = "^%!"
    Dim cifra As String = "0123456789"
    Sub Main()
        Try
            Console.WriteLine("Please, type in the expression to calculate:")
            line = Console.ReadLine
            Dim db As Double
            Dim nIter As Int32 = 1000
            Dim t1 As Long = Now.Ticks
            For i As Int32 = 1 To nIter
                curChar = 0
                db = expression()
            Next
            Dim t2 As Long = Now.Ticks - t1
            Console.WriteLine(String.Format( _
            "{0} ({1} iterations, average time = {2} miliseconds", _
            db, nIter, t2 / 10 ^ 7 / nIter))
            Console.ReadLine()
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Console.ReadLine()
        End Try
    End Sub

    Sub advance()
        Try
            curChar += 1
            Do While curChar < Len(line) AndAlso line.Chars(curChar) = " "
                curChar += 1
            Loop
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Function expression() As Double
        Dim value As Double
        Dim optor As Char
        Try
            value = term()
            Do While curChar < Len(line) AndAlso _
            InStr(oper_AD, line.Chars(curChar))
                optor = line.Chars(curChar)
                advance()
                If optor = "+" Then
                    value += term()
                Else
                    value -= term()
                End If
            Loop
        Catch ex As Exception
            Throw ex
        End Try
        Return value
    End Function
    Function term() As Double
        Dim value As Double
        Dim optor As Char
        Try
            value = pow()
            Do While curChar < Len(line) AndAlso _
            InStr(oper_MUL, line.Chars(curChar))
                optor = line.Chars(curChar)
                advance()
                If optor = "*" Then
                    value *= term()
                Else
                    value /= term()
                End If
            Loop
        Catch ex As Exception
            Throw ex
        End Try
        Return value
    End Function
    Function pow() As Double
        Dim value As Double
        Dim optor As Char
        Try
            value = token()
            Do While curChar < Len(line) AndAlso _
            InStr(oper_POW, line.Chars(curChar))
                optor = line.Chars(curChar)
                advance()
                If optor = "^" Then
                    value ^= term()
                ElseIf optor = "%" Then
                    value = value Mod term()
                Else
                    For i As Int32 = Math.Floor(value) - 1 To 2 Step -1
                        value *= i
                    Next
                End If
            Loop
        Catch ex As Exception
            Throw ex
        End Try
        Return value
    End Function
    Function token() As Double
        Dim value As Double = 0.0
        Try
            If line.Chars(curChar) = "(" Then
                advance()
                token = expression()
                If line.Chars(curChar) <> ")" Then
                    Throw New Exception("Missing a matching ')'.")
                End If
                advance()
            Else
                If InStr(cifra, line.Chars(curChar)) = 0 Then
                    Throw New Exception("Number or '(' expected.")
                End If
                Do While curChar < Len(line) AndAlso _
                    InStr(cifra, line.Chars(curChar))
                    value = value * 10 + Asc(line.Chars(curChar)) - Asc("0")
                    curChar += 1
                Loop
                If curChar < Len(line) AndAlso line.Chars(curChar) = " " Then
                    advance()
                End If
                token = value
            End If
        Catch ex As Exception
            Throw ex
        End Try
    End Function
End Module

Although it is a simple example, I hope you catch the idea behind.

 
0
 

Present explanation is about version 8.4.1. There have been many changes, so the code is differs slightly from 8.4.0: I am sorry for the inconvients it may cause.
But, now, the code seems to me pretty fast, considering we are talking about VBasic. In a desktop (Pc @3GHz-64bits Windows 8.1) the average time for an expression like 1600/((1-(1+1/4)^30)/(1-(1+1/4))) it can take about 10/20 ns to process the arithmetic:
29039bd20b59281c29c45331ceb85121
Lets enumerate the classes. These are:
exprParser
m8Response
MathGlobal8
msg8
RPN_Stack

At the moment, a Mates8 client just needs to be employ exprParser and m8Response classes.
Imports Mates8

Public Class Form1
    Dim eP As exprParser
    Dim nIter As Int32 = 1000
    Const ticks_second = 10 ^ 7
    Const ms_second = 1000

#Region "Calculate"
    Sub Calculate()
        Try
            Dim t1 As Int64 = Now.Ticks
            Dim db As Double
            tbOutput.Text = ""
            lblStack.Text = ""

            eP = New exprParser(modeType.Calculate, tbInput.Text)

            For i = 1 To nIter
                If Not eP.Parse(db) Then
                    ' Show error message:
                    lblMessage.Text = eP.retErr.ToString
                    Exit Sub
                End If
            Next
            Dim t2 As Int64 = Now.Ticks - t1
            ' Show the result:
            tbOutput.Text = eP.ret.ToString
            lblMessage.Text = String.Format("exprParse.Parse()" + vbCrLf +               "Average Time: {0} ms " +
                   vbCrLf + "({1} iterations)", ((t2 / ticks_second / nIter _
                   ) * ms_second).ToString(MathGlobal8.us), nIter)
        Catch ex As Exception
            MessageBox.Show("Unexpected error:" + vbCrLf + ex.Message)
        End Try
    End Sub
#End Region

Evaluating the stack is much faster, once the stack has been obtained. The use of the stack will make sense when variables come into play , not now.

f060587525d3fc55646fac63833323f7

    Private Sub btnEval_Click(sender As Object, e As EventArgs) Handles btnEval.Click
        Try

            Dim db As Double
            eP = New exprParser( _
                modeType.PrepareForEval, tbInput.Text) ' Get RPN_Stack
            If Not eP.Parse(tbInput.Text, db) Then
                ' Show error message:
                lblMessage.Text = eP.retErr.ToString
                Exit Sub
            End If

            ' Show the stack:
            tbOutput.Text = ""
            LBStack.Items.Clear()
            For i As Int32 = 0 To eP.ret.rpn.length - 1
                LBStack.Items.Add(eP.ret.rpn.Item(i).ToString)
            Next

            If LBStack.Items.Count Then
                Dim t1 As Int64 = Now.Ticks
                For i As Int32 = 1 To nIter
                    db = eP.ret.rpn.Eval '  Evaluate
                    If eP.retErr IsNot Nothing Then
                        Exit For
                    End If
                Next
                Dim t2 As Int64 = Now.Ticks - t1
                If eP.retErr Is Nothing Then
                    ' OK
                    lblStack.Text = db.ToString(MathGlobal8.us)
                    lblMessage.Text = String.Format("RPN_Stack.Eval()" + vbCrLf + "Average Time: {0} ms " +
                           vbCrLf + "({1} iterations)", ((t2 / ticks_second / nIter _
                           ) * ms_second).ToString(MathGlobal8.us), nIter)
                Else
                    lblMessage.Text = eP.retErr.Message
                    lblStack.Text = ""
                End If
            End If
        Catch ex As Exception
            MessageBox.Show("Unexpected error:" + vbCrLf + ex.Message)
        End Try
    End Sub

In present version just mode=calculate takes sense. 'PrepareForEval' does the same as 'calculate' and also obtains a RPN_Stack instance.

Attachments
 
0
 

If you have understood the above "Module1" example, you'll also see that class exprParser follows similar mechanics: nextExpr() calls nextTerm() which, in turn, calls nextPow(), that calls nextToken(). Here, nextToken() grabs the next number and operator (unless it's the last token) before returning.

Imports System.Text.RegularExpressions
Imports System.Text

<Serializable()> _
Public Class exprParser

    Dim bGetRPN As Boolean
    Dim cnt As Int32
    Dim iRe, curOp As Int32
    Dim curNum As Double
    Dim sExpr As String
    Dim vByte() As Byte
    Dim ln As Int32
    Friend err As Exception
    Public ret As m8Response
    Dim rpn As RPN_Stack
    Dim mode As modeType
    Dim reNum As Regex = MathGlobal8.reNum
    Public Sub New(mode As modeType, Optional strToParse As String = "")
        Try
            InitStr(strToParse)
            Me.mode = mode
            Init()
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Sub Init()
        Try
            ret = New m8Response
            If (mode And modeType.PrepareForEval) Then
                bGetRPN = True
            Else
                bGetRPN = False
            End If
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Sub InitStr(strToParse As String)
        Me.sExpr = strToParse
        vByte = Text.ASCIIEncoding.ASCII.GetBytes(sExpr)
        ln = vByte.Length
    End Sub
    Public Function Parse(strToParse As String, ByRef Result As Double) As Boolean
        Dim bRet As Boolean
        Try
            InitStr(strToParse)
            bRet = Parse(Result)
        Catch ex As Exception
            err = ex
            bRet = False
        End Try
        Return bRet
    End Function
    Public Function Parse(ByRef Result As Double) As Boolean
        Try

            cnt = 0 : iRe = 0 : curNum = 0.0 : err = Nothing

            If Not rpn.bInitialized Then
                rpn = New RPN_Stack(Me, ln * 3 / 2)
            End If

            nextExpr()

            If err Is Nothing Then
                ret.rpn = rpn
                Return True
            End If
        Catch ex As Exception
            err = ex
        Finally
        End Try
        Return False
    End Function
    Private Sub nextExpr()          ' - +

        Try

            nextTerm()
            Do While curOp = 45 OrElse curOp = 43
                Dim prevOp As Int32 = curOp
                Dim dbA As Double = curNum
                nextTerm()
                If bGetRPN Then rpn.Add(New StackTkn(prevOp, 0)) ' operator
                If prevOp = 43 Then
                    dbA += curNum
                Else
                    dbA -= curNum
                End If
                curNum = dbA
            Loop
            ret.retDouble = curNum
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Private Sub nextTerm()  '       * /
        Try
            nextPow()

            Do While curOp = 42 OrElse curOp = 47
                Dim dbA As Double = curNum
                Dim prevOp As Int32 = curOp
                nextPow()
                If bGetRPN Then rpn.Add(New StackTkn(prevOp, 0)) ' operator
                If prevOp = 42 Then
                    dbA *= curNum
                Else
                    dbA /= curNum
                End If
                curNum = dbA
            Loop
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Private Sub nextPow() '    ^ !
        Dim sgn As Int32
        Try

            nextToken(sgn)

            Do While curOp = 94 OrElse curOp = 37

                If curOp = 94 Then ' ^
                    Dim dbB(0) As Double, vSgn(0) As Int32
                    Dim iv As Int32 = 0

                    Dim dbA As Double = curNum
                    dbB(0) = curNum

                    Do
                        ReDim Preserve dbB(iv), vSgn(iv)
                        nextToken(vSgn(iv))
                        dbB(iv) = curNum
                        iv += 1
                    Loop While curOp = 94
                    For i = iv - 1 To 1 Step -1
                        If vSgn(i) = -1 Then
                            dbB(i - 1) ^= -dbB(i)
                            If bGetRPN Then rpn.AddChgSgn()
                        Else
                            dbB(i - 1) ^= dbB(i)
                        End If
                        If bGetRPN Then rpn.Add(New StackTkn(94, 0)) ' operator
                    Next
                    If vSgn(0) = -1 Then
                        dbA ^= -dbB(0)
                        If bGetRPN Then rpn.AddChgSgn()
                    Else
                        dbA ^= dbB(0)
                    End If
                    curNum = dbA
                    If bGetRPN Then rpn.Add(New StackTkn(94, 0)) ' operator
                Else
                    ' %
                    Dim dbA As Double = sgn * curNum
                    nextToken(sgn)
                    curNum = dbA Mod curNum
                End If
            Loop
            If sgn = -1 Then
                curNum *= -1
                If bGetRPN Then rpn.AddChgSgn()
            End If
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Private Sub nextToken(ByRef sgn As Int32)
        Dim c As Int32
        Dim bNotUnary As Boolean
        Try
            sgn = 1
            Do

                c = vByte(iRe)
                If c = 45 OrElse c = 43 OrElse c = 42 OrElse c = 47 _
                OrElse c = 94 OrElse c = 37 OrElse c = 33 Then
                    ' -  +  *  /  ^  %  !  .  : 
                    '45 43 42 47 94 37 33 46 58
                    If c <> 33 Then
                        If bNotUnary OrElse _
                         (c <> 45 AndAlso c <> 43) Then
                            curOp = c
                            cnt += 1
                            iRe += 1
                            bNotUnary = False
                            Exit Try
                        ElseIf c = 45 Then
                            sgn *= -1
                        Else
                            ' c=43: do nothing
                        End If
                        iRe += 1
                    Else
                        ' !
                        If bGetRPN Then rpn.Add(New StackTkn(c, 0)) ' operator
                        For i As Int32 = Math.Floor(curNum) - 1 To 2 Step -1
                            curNum *= CDbl(i)
                        Next
                        iRe += 1
                    End If
                ElseIf (48 <= c AndAlso c <= 57) OrElse c = 46 Then
                    Dim mNum As Match = reNum.Match(sExpr, iRe)
                    If mNum.Success Then
                        cnt += 1
                        iRe += mNum.Length
                        Double.TryParse(mNum.ToString, _
                            Globalization.NumberStyles.Float Or _
                            Globalization.NumberStyles.AllowThousands, _
                            MathGlobal8.us, curNum)
                        If bGetRPN Then rpn.Add(New StackTkn(0, curNum)) ' operator
                        cnt += 1
                    Else
                    End If
                ElseIf c = 40 Then ' LP
                    cnt += 1
                    iRe += 1
                    Dim sgnAux As Int32 = sgn
                    bNotUnary = False
                    nextExpr()
                    curNum = ret.retDouble
                    sgn = sgnAux
                ElseIf c = 41 Then
                    rpn.oStack(cnt) = New StackTkn(-2, 0) ' 41=RP
                    curOp = -1
                    cnt += 1
                    iRe += 1
                    Exit Try
                ElseIf c = 38 Then ' 38="&"
                    ' TODO
                ElseIf c = 39 Then ' 39="'"
                    ' TODO
                ElseIf c = 44 Then ' 44=","
                    ' TODO
                End If

                bNotUnary = True

            Loop While iRe < ln
            curOp = -3 ' EOTokens
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Public ReadOnly Property retErr As msg8
        Get
            If err Is Nothing OrElse _
            err.Message Is Nothing Then
                Return Nothing
            End If
            Return err
        End Get
    End Property
End Class
Public Enum action
    OK
    insertMult
    insertPow
    substitute
    chgNumBase
    chgAngleUnits
    err
End Enum
 
0
 

"reNum" stands for a Regex instance defined in class MathGlobal8. The purpose of "reNum" is to parse a number out from input string:

Imports System.Reflection
Imports System.Text.RegularExpressions
Imports System.Runtime.Serialization

<Serializable()> _
Public Class MathGlobal8

    Public Shared us As New Globalization.CultureInfo("en-US")
    Public Shared sNum = "(?<num>(([0-9]{1,3},[0-9]{3}(?![0-9])|[0-9])+\.?[0-9]*|[0-9]*\.?[0-9]+)([eE][-+]?[0-9]+)?)"
    Public Shared reNum As New Regex(sNum)

    Shared Function NameAndVersion() As String
        Dim sNV As String = String.Empty
        Try
            Dim asmbly As Assembly = System.Reflection.Assembly.GetAssembly(GetType(MathGlobal8))
            Dim name As AssemblyName = asmbly.GetName()
            sNV = name.Version.ToString
            sNV = name.Name + " -- " + Left(sNV, Len(sNV) - 2)
        Catch ex As Exception

        End Try
        Return sNV
    End Function

End Class
 
0
 

Finally, the other 3 classes are:

Public Class m8Response
    Public sExpression As String
    Public retDouble As Double
    Public rpn As RPN_Stack
    Public Overrides Function ToString() As String
        Return retDouble.ToString(MathGlobal8.us)
    End Function
End Class




Public Class msg8
    Inherits ApplicationException

    Dim eP As exprParser
    Dim msg As String
    Public Sub New()
    End Sub
    Public Sub New(exprP As exprParser)
        eP = exprP
    End Sub
    Private Function msgN(n As Int32) As String
        Dim e1 As String = String.Empty
        Try
            Select Case n
                Case 1 : e1 = "Empty expression."
                Case 2 : e1 = "Token sequence ""{0} {1}"" is not valid."
                Case 3 : e1 = "Ending token ""{0}"" is not valid."
                Case 4 : e1 = "Starting token is not valid."
                Case 5 : e1 = "n/a: the expression is incomplete/unintelligible."
                Case 6 : e1 = "n/a, token ""{0}"" is unknown/not allowed."
                Case 7 : e1 = "Argument out of bounds."
                Case 8 : e1 = "n/a: stack is empty."
                Case 9 : e1 = "n/a: missing one or more matching left parenthesis."
                Case 10 : e1 = "n/a: missing one or more matching right parenthesis."
            End Select
        Catch ex As Exception
            Throw ex
        End Try
        Return e1
    End Function
    Public ReadOnly Property num(ByVal i As Int32, ParamArray Arr() As Object) As Exception
        Get
            Try
                If i < 1 Then
                    msg = "n/a"
                ElseIf Arr IsNot Nothing Then
                    Dim e1 As String = msgN(i)
                    msg = String.Format(e1, Arr)
                Else
                    msg = msgN(i)
                End If
            Catch ex As Exception
                Throw ex
            End Try
            Return Me
        End Get
    End Property
    Public Overrides ReadOnly Property Message As String
        Get
            Return msg
        End Get
    End Property
    Public Overrides Function ToString() As String
        Return msg
    End Function
End Class




Imports System.Text

Public Structure RPN_Stack ' Reverse Polish Notation 
    ' http://en.wikipedia.org/wiki/Reverse_Polish_notation

    Dim iSt As Int32
    Dim eP As exprParser
    Dim oStack() As StackTkn
    Friend Sub New(eP As exprParser, size As Int32)
        Me.eP = eP
        ReDim oStack(size)
    End Sub
    Friend Function Copy() As RPN_Stack
        Dim rpn As New RPN_Stack
        Try
            rpn.eP = eP
            ReDim rpn.oStack(oStack.Length - 1)
            Array.Copy(oStack, rpn.oStack, oStack.Length)
            rpn.iSt = iSt
        Catch ex As Exception
            Throw ex
        End Try
        Return rpn
    End Function
    Friend Sub Clear()
        iSt = 0
    End Sub
    Friend Sub Add(elem As StackTkn)
        Try
            If elem.tipo < 0 Then
                Exit Sub
            End If
            If iSt >= oStack.Length Then
                ReDim Preserve oStack(iSt + 20)
            End If
            oStack(iSt) = elem
            iSt += 1
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Friend Sub AddChgSgn()
        Try
            If iSt >= oStack.Length Then
                ReDim Preserve oStack(iSt + 20)
            End If
            oStack(iSt) = New StackTkn(-1, 0.0)
            iSt += 1
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Friend Sub EOParsing()
        Try
            ReDim Preserve oStack(iSt - 1)
        Catch ex As Exception

        End Try
    End Sub
    Public ReadOnly Property bInitialized As Int32
        Get
            Return (oStack IsNot Nothing)
        End Get
    End Property
    Public ReadOnly Property length() As Int32
        Get
            Return Me.iSt
        End Get
    End Property
    Public ReadOnly Property Item(index As Int32) As StackTkn
        Get
            If index < 0 OrElse index >= iSt Then
                Throw New IndexOutOfRangeException
            End If
            Return oStack(index)
        End Get
    End Property
    Public Function Eval() As Double

        ' http://en.wikipedia.org/wiki/Reverse_Polish_notation

        ' Array vDbl() will contain the (numeric) operands:
        Dim vDbl(0) As Double, iv As Int32
        Dim i As Int32
        Try
            If iSt = 0 OrElse oStack(0) Is Nothing Then
                Dim err8 As New msg8
                eP.err = err8.num(8) ' Stack is empty
                Exit Try
            ElseIf iSt = 1 Then
                vDbl(0) = oStack(0).dblVal
                Exit Try
            End If
            Do
                ' get next operator's position:
                Do
                    If oStack(i).tipo = 0 Then
                        ' stack(i) holds an operand:
                        ReDim Preserve vDbl(iv)
                        vDbl(iv) = oStack(i).dblVal
                        iv += 1
                        i += 1
                    Else
                        ' operator found: exit
                        Exit Do
                    End If
                Loop

                ' Evaluate current operands, the last element of vDbl() in
                ' case of a one operand operator (for example 5! or -(5)),
                ' or the last 2 elements of vDbl() for a 2 operand operator
                ' (for instance 4*5):
                ' -  +  *  /  ^  %  ! : 
                '45 43 42 47 94 37 33 58
                Select Case oStack(i).tipo
                    Case 33 ' "!" has 1 operand
                        Dim opA As Double = vDbl(iv - 1)
                        For j As Int64 = Math.Floor(opA) - 1 To 2 Step -1
                            opA *= j
                        Next
                        ' Replace by the operation result:
                        vDbl(iv - 1) = opA
                    Case -1 ' unary minus:
                        Dim opA As Double = vDbl(iv - 1)
                        ' Replace by the operation result:
                        vDbl(iv - 1) *= -1
                        'Case fn
                        ' TODO
                    Case Else ' Here, all operations imply 2 operands:
                        Dim opA As Double = vDbl(iv - 2)
                        Dim opB As Double = vDbl(iv - 1)

                        ' MathGlobal8.vOp(): {"+", "-", "*", "/", "^", "%", "!"}
                        '                      0    1    2    3    4    5    6 
                        Select Case oStack(i).tipo
                            Case 43 : opA += opB
                            Case 45 : opA -= opB
                            Case 42 : opA *= opB
                            Case 47 : opA /= opB
                            Case 94 : opA ^= opB
                            Case 37 : opA = opA Mod opB
                        End Select
                        ' Replace by the operation result:
                        vDbl(iv - 2) = opA
                        iv -= 1 ' decrement to discard last element in vDbl,
                        ' because out from 2 operands there is just 1 result, so
                        ' the last position is discarded and the one before now
                        ' contains the result.
                End Select
                i += 1
            Loop While i < iSt
        Catch ex As Exception
            eP.err = ex
        End Try
        Return vDbl(0)
    End Function
End Structure


Public Class StackTkn
    Public tipo As Int32
    Public dblVal As Double
    Public Sub New(tipo As Int32, value As Double)
        Me.tipo = tipo
        Me.dblVal = value
    End Sub
    Public Overrides Function ToString() As String
        If tipo = -1 Then
            Return "- (unary)"
        ElseIf tipo > 0 Then
            Return Chr(tipo)
        End If
        Return dblVal.ToString(MathGlobal8.us)
    End Function
End Class




Imports System.Text

Public Structure RPN_Stack ' Reverse Polish Notation 
    ' http://en.wikipedia.org/wiki/Reverse_Polish_notation

    Dim iSt As Int32
    Dim eP As exprParser
    Dim oStack() As StackTkn
    Friend Sub New(eP As exprParser, size As Int32)
        Me.eP = eP
        ReDim oStack(size)
    End Sub
    Friend Function Copy() As RPN_Stack
        Dim rpn As New RPN_Stack
        Try
            rpn.eP = eP
            ReDim rpn.oStack(oStack.Length - 1)
            Array.Copy(oStack, rpn.oStack, oStack.Length)
            rpn.iSt = iSt
        Catch ex As Exception
            Throw ex
        End Try
        Return rpn
    End Function
    Friend Sub Clear()
        iSt = 0
    End Sub
    Friend Sub Add(elem As StackTkn)
        Try
            If elem.tipo < 0 Then
                Exit Sub
            End If
            If iSt >= oStack.Length Then
                ReDim Preserve oStack(iSt + 20)
            End If
            oStack(iSt) = elem
            iSt += 1
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Friend Sub AddChgSgn()
        Try
            If iSt >= oStack.Length Then
                ReDim Preserve oStack(iSt + 20)
            End If
            oStack(iSt) = New StackTkn(-1, 0.0)
            iSt += 1
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Friend Sub EOParsing()
        Try
            ReDim Preserve oStack(iSt - 1)
        Catch ex As Exception

        End Try
    End Sub
    Public ReadOnly Property bInitialized As Int32
        Get
            Return (oStack IsNot Nothing)
        End Get
    End Property
    Public ReadOnly Property length() As Int32
        Get
            Return Me.iSt
        End Get
    End Property
    Public ReadOnly Property Item(index As Int32) As StackTkn
        Get
            If index < 0 OrElse index >= iSt Then
                Throw New IndexOutOfRangeException
            End If
            Return oStack(index)
        End Get
    End Property
    Public Function Eval() As Double

        ' http://en.wikipedia.org/wiki/Reverse_Polish_notation

        ' Array vDbl() will contain the (numeric) operands:
        Dim vDbl(0) As Double, iv As Int32
        Dim i As Int32
        Try
            If iSt = 0 OrElse oStack(0) Is Nothing Then
                Dim err8 As New msg8
                eP.err = err8.num(8) ' Stack is empty
                Exit Try
            ElseIf iSt = 1 Then
                vDbl(0) = oStack(0).dblVal
                Exit Try
            End If
            Do
                ' get next operator's position:
                Do
                    If oStack(i).tipo = 0 Then
                        ' stack(i) holds an operand:
                        ReDim Preserve vDbl(iv)
                        vDbl(iv) = oStack(i).dblVal
                        iv += 1
                        i += 1
                    Else
                        ' operator found: exit
                        Exit Do
                    End If
                Loop

                ' Evaluate current operands, the last element of vDbl() in
                ' case of a one operand operator (for example 5! or -(5)),
                ' or the last 2 elements of vDbl() for a 2 operand operator
                ' (for instance 4*5):
                ' -  +  *  /  ^  %  ! : 
                '45 43 42 47 94 37 33 58
                Select Case oStack(i).tipo
                    Case 33 ' "!" has 1 operand
                        Dim opA As Double = vDbl(iv - 1)
                        For j As Int64 = Math.Floor(opA) - 1 To 2 Step -1
                            opA *= j
                        Next
                        ' Replace by the operation result:
                        vDbl(iv - 1) = opA
                    Case -1 ' unary minus:
                        Dim opA As Double = vDbl(iv - 1)
                        ' Replace by the operation result:
                        vDbl(iv - 1) *= -1
                        'Case fn
                        ' TODO
                    Case Else ' Here, all operations imply 2 operands:
                        Dim opA As Double = vDbl(iv - 2)
                        Dim opB As Double = vDbl(iv - 1)

                        ' -  +  *  /  ^  %  !
                        '45 43 42 47 94 37 33
                        Select Case oStack(i).tipo
                            Case 43 : opA += opB
                            Case 45 : opA -= opB
                            Case 42 : opA *= opB
                            Case 47 : opA /= opB
                            Case 94 : opA ^= opB
                            Case 37 : opA = opA Mod opB
                        End Select
                        ' Replace by the operation result:
                        vDbl(iv - 2) = opA
                        iv -= 1 ' decrement to discard last element in vDbl,
                        ' because out from 2 operands there is just 1 result, so
                        ' the last position is discarded and the one before now
                        ' contains the result.
                End Select
                i += 1
            Loop While i < iSt
        Catch ex As Exception
            eP.err = ex
        End Try
        Return vDbl(0)
    End Function
End Structure
Public Class StackTkn
    Public tipo As Int32
    Public dblVal As Double
    Public Sub New(tipo As Int32, value As Double)
        Me.tipo = tipo
        Me.dblVal = value
    End Sub
    Public Overrides Function ToString() As String
        If tipo = -1 Then
            Return "- (unary)"
        ElseIf tipo > 0 Then
            Return Chr(tipo)
        End If
        Return dblVal.ToString(MathGlobal8.us)
    End Function
End Class
 
0
 

Here is the next Mates8 version (8.4.2). I have tried to give more explanations but perhaps not so much as it would be convinient. So, I beg your pardon for this and for my lack of good english, although you may be sure I strive hard -or that's what I believe.
If you are interested in Mates8v8.4.2 you may take a look to the images here or download the .pdf tutorial (contents should be the same) and the .zip file of the source code.
b58000387eec862d0f89351d9c1e21eba4fcc9cfbd92d7ba4a82d1d4df7ace71707103716af8fd61e23bf50ed8c0f58dcf0c6da11157616f69084394f5b9a176df74e9a6e5401fad652186f426e2d812

Attachments
 
0
 

16dfea3fc52b71aa61803657eb9c7cf24d08b66c8f2e9dd9c45ff169a44fe198
Hoping you take advantage out of this tutorial, best regards.
Xavier.

Attachments tutorialv8_4_2.pdf (294.95KB) Mates8v8.4_.2_.zip (306.31KB)
 
0
 

Today's release Mates8v8.4.3 is composed a zip file containing the source code (the executable is in folder ...\testMates8\testMates8\bin\Debug\testMates8.exe) and a .pdf document.

Attachments Mates8v8.4_.3_.zip (294.28KB) tutorialv8_4_3.pdf (315.11KB)
 
0
 

If you have downloaded the last zip file it is plausible you have noticed a bug, when the input expression is not a valid expression. This is because in the message class 'msg8' the code of the msgN() function should be replaced by the following code:

    Private Function msgN(n As Int32, Optional Arr() As String = Nothing) As String
        Dim e1 As String = String.Empty
        Try
            Select Case n
                Case 1 : e1 = "Empty expression."
                Case 2
                    Dim sL As String = ""
                    Dim pos As Int32 = eP.iRe - 1
                    If pos > 0 Then sL = eP.sbExpr.ToString.Substring(0, pos)
                    Dim sR As String = ""
                    If pos + Join(Arr, "").Length < eP.sbExpr.Length Then
                        sR = eP.sbExpr.ToString.Substring(pos + Join(Arr, "").Length)
                    End If
                    e1 = "Token sequence: " + vbCrLf + sL + " [{0}{1}] " + sR + vbCrLf + " is not valid."
                Case 3 : e1 = "End token ""{0}"" is not valid."
                Case 4 : e1 = "Start token ""{0}"" is not valid."
                Case 5 : e1 = "n/a, the expression is incomplete/unintelligible."
                Case 6 : e1 = "n/a, token ""{0}"" is unknown or not allowed."
                    'Case 7 : e1 = "Argument out of bounds."
                Case 8 : e1 = "n/a, stack is empty."
                Case 9 : e1 = "n/a, missing one or more matching left parenthesis."
                Case 10 : e1 = "n/a, missing one or more matching right parenthesis."
                Case 11 : e1 = "n/a, could not found variable ""{0}"" or its value."
                Case 12 : e1 = "n/a, couldn't find variable ""{0}""."
                Case Else : e1 = "n/a"
            End Select
            Dim e2 As String = String.Empty
            If Arr IsNot Nothing Then
                If eP.cfg.outputFormat <> outputMessage.plainText Then
                    If eP.cfg.outputFormat = outputMessage.RichTextFormat Then
                    End If
                    ' If HTML, highlight the token(s)/parameter(s) in red:
                    For i As Int32 = 0 To Arr.Length - 1
                        If eP.cfg.outputFormat = outputMessage.RichTextFormat Then
                            e1 = Replace(e1, "{" + i.ToString + "}", _
                              "\cf2{@}\cf1")
                            e1 = Replace(e1, " [", "")
                            e1 = Replace(e1, "] ", "")
                            Arr(i) = Replace(Arr(i), "\", "\\")
                        Else
                            e1 = Replace(e1, "{" + i.ToString + "}", _
                              "<span style=""color:red"">{@}</span")
                        End If
                        e1 = Replace(e1, "@", i.ToString)
                    Next
                End If
                If eP.cfg.outputFormat = outputMessage.RichTextFormat Then
                    e1 = Replace(e1, vbCrLf, "\line" + vbCrLf)
                End If
                e1 = String.Format(e1, Arr)
            End If
            If eP.cfg.outputFormat = outputMessage.RichTextFormat Then
                e2 = "{\rtf1\ansi\deff0 {\fonttbl {\f0 Calibri;}}" + vbCrLf + _
                    "{\colortbl;\red0\green0\blue0;\red255\green0\blue0;}" + vbCrLf
            End If
            e1 = e2 + e1
        Catch ex As Exception
            Throw ex
        End Try
        Return e1
    End Function

The initializing string for the Rich Text Box, rtfInput, sometimes was not assigned producing an exception that implied the application close.

 
0
 

For convinience's sake, attached, you may find the zip including only the executable and the full source code, fixed. I hope, for next time, there'll be some algebra operations.

Attachments testMates8.zip (11.5KB) Mates8v8.4_.4_.zip (293.42KB)
 
0
 

As you may see in the images about Mates8 (version 8.4.6), it can manage polynomials, although finds no roots yet. Multiplication and division of polynomials can be detailed.

d1c2484283ce1433f4b0cc8eccea7856

fd3e1a082288edc1e0a9bf8cd2894acb

c7f56423e675e2dfa5e7ade7da60c291

Attachments testMates8.4_.6_.zip (11.58KB) Mates8v8.4_.6_.zip (682.54KB)
You
Post:
Start New Discussion
View similar articles that have also been tagged: