Option Strict On

​

Imports System

Imports System.Collections.Generic

Imports System.Text.RegularExpressions

​

Public Module Module1

    Public Sub Main()

        Dim expression1 As String = "1 + 2 * 3"

        Dim result As Double = ExpressionEvaluator.Evaluate(expression1)

        Console.WriteLine("Expression1: {0}", result)

        Dim expression2 As String = "1 * 2 + 3"

        result = ExpressionEvaluator.Evaluate(expression2)

        Console.WriteLine("Expression2: {0}", result)

    End Sub

End Module

​

Public Module ExpressionEvaluator

​

    Public Function Evaluate(ByVal expression As String) As Double

        Dim rpn As Queue(Of String) = ShuntingYardAlgorithm(expression)

        Dim value As Double

        If rpn.Count = 1 AndAlso Not Double.TryParse(rpn.Dequeue(), value) Then

            Throw New ArithmeticException("The expression is not in a valid format.")

        ElseIf rpn.Count > 1 Then

            Dim operations As New Dictionary(Of String, Operation) From {{"+", New Operation(AddressOf Sum)}, {"-", New Operation(AddressOf Difference)}, {"*", New Operation(AddressOf Multiplication)}, {"/", New Operation(AddressOf Division)}, {"%", New Operation(AddressOf Modulous)}, {"^", New Operation(AddressOf Power)}}

            Dim values As New Stack(Of Double)

            Dim currentValue As Double

            For Each lexeme As String In rpn

                If Double.TryParse(lexeme, currentValue) Then

                    values.Push(currentValue)

                ElseIf operations.ContainsKey(lexeme) Then

                    Dim value2 As Double = values.Pop()

                    values.Push(operations(lexeme).Invoke(values.Pop(), value2))

                Else

                    Throw New ArithmeticException("The expression is not in a valid format.")

                End If

            Next

​

            value = values.Pop()

        End If

​

        Return value

    End Function

​

    Private Function ShuntingYardAlgorithm(ByVal source As String) As Queue(Of String)

        Dim output As New Queue(Of String)

        Dim operators As New Stack(Of String)

        Dim operatorPrecedence As New Dictionary(Of String, Integer) From {{"+", 1}, {"-", 1}, {"*", 2}, {"/", 2}, {"%", 2}, {"^", 3}}

        Dim numberState As Boolean = True

        source = New Regex("\s").Replace(source, String.Empty)

        Dim lexeme As String = String.Empty

        Do Until String.IsNullOrWhiteSpace(source)

            If numberState Then

                lexeme = Parse_Number(source)

            End If

​

            If Not String.IsNullOrWhiteSpace(lexeme) Then

                output.Enqueue(lexeme)

                numberState = Not numberState

            Else

                If Not numberState Then

                    lexeme = Parse_Operator(source)

                End If

​

                If Not String.IsNullOrWhiteSpace(lexeme) Then

                    Do While operators.Count > 0 AndAlso operatorPrecedence.ContainsKey(operators.Peek()) AndAlso operatorPrecedence(lexeme) <= operatorPrecedence(operators.Peek)

                        output.Enqueue(operators.Pop())

                    Loop

​

                    operators.Push(lexeme)

                    numberState = Not numberState

                ElseIf source(0) = "("c Then

                    operators.Push(source(0))

                    source = source.Remove(0, 1)

                ElseIf source(0) = ")"c Then

                    Do Until operators.Peek() = "("

                        output.Enqueue(operators.Pop())

                    Loop

​

                    If operators.Count > 0 Then

                        operators.Pop()

                        source = source.Remove(0, 1)

                    Else

                        Throw New ArithmeticException("Parenthesis mismatch. There are more open parenthesis than closed parenthesis.")

                    End If

                Else

                    Throw New ArithmeticException(String.Format("{0} is an invalid lexeme", source(0)))

                End If

            End If

​

            lexeme = String.Empty

        Loop

​

        Do While operators.Count > 0

            lexeme = operators.Peek()

            If lexeme = "(" Then

                Throw New ArithmeticException("Parenthesis mismatch. There are more open parenthesis than closed parenthesis.")

            ElseIf lexeme = ")" Then

                Throw New ArithmeticException("Parenthesis mismatch. There are more closed parenthesis than open parenthesis.")

            Else

                output.Enqueue(operators.Pop())

            End If

        Loop

​

        Return output

    End Function

​

    Private Function Parse_Number(ByRef source As String) As String

        Dim m As Match = New Regex("[+-]?\d+(\.\d+)?([eE][+-]?\d+)?").Match(source)

        Dim parsedNumber As String = String.Empty

        If m.Success AndAlso m.Index = 0 Then

            parsedNumber = m.Value

            source = source.Remove(0, m.Value.Length)

        End If

​

        Return parsedNumber

    End Function

​

    Private Function Parse_Operator(ByRef source As String) As String

        Dim operators As String = "+-*/%^"

        Dim parsedOperator As String = String.Empty

        If operators.IndexOf(source(0)) <> -1 Then

            parsedOperator = source(0)

            source = source.Remove(0, 1)

        End If

​

        Return parsedOperator

    End Function

​

    Private Function Sum(ByVal operand1 As Double, ByVal operand2 As Double) As Double

        Return operand1 + operand2

    End Function

​

    Private Function Difference(ByVal operand1 As Double, ByVal operand2 As Double) As Double

        Return operand1 - operand2

    End Function

​

    Private Function Multiplication(ByVal operand1 As Double, ByVal operand2 As Double) As Double

        Return operand1 * operand2

    End Function

​

    Private Function Division(ByVal operand1 As Double, ByVal operand2 As Double) As Double

        Return operand1 / operand2

    End Function

​

    Private Function Modulous(ByVal operand1 As Double, ByVal operand2 As Double) As Double

        Return operand1 Mod operand2

    End Function

​

    Private Function Power(ByVal operand1 As Double, ByVal operand2 As Double) As Double

        Return operand1 ^ operand2

    End Function

​

    Private Delegate Function Operation(ByVal operand1 As Double, ByVal operand2 As Double) As Double

End Module