众果搜的博客

148 "vb.net表达式求值（推荐使用）" "表达式求值是数据结构和编译原理中主要内容，最近编程用到该算法，为了图方便，找到以下VB.net源码的函数，你可以在程序中使用。可以用来将包含表达式的字符串的转换为数值类型。<br>Imports&nbsp;System.Text.RegularExpressions<br>Module&nbsp;EvalModule<br>&nbsp;&nbsp;&nbsp;&nbsp;Function&nbsp;Evaluate(ByVal&nbsp;expr&nbsp;As&nbsp;String)&nbsp;As&nbsp;Double<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Const&nbsp;Num&nbsp;As&nbsp;String&nbsp;=&nbsp;&quot;(\-?\d+\.?\d*)&quot;" "表达式求值是数据结构和编译原理中主要内容，最近编程用到该算法，为了图方便，找到以下VB.net源码的函数，你可以在程序中使用。可以用来将包含表达式的字符串的转换为数值类型。
Imports System.Text.RegularExpressions
Module EvalModule
    Function Evaluate(ByVal expr As String) As Double
        Const Num As String = "(\-?\d+\.?\d*)"
        Const Func1 As String = "(exp|log|log10|abs|sqr|sqrt|sin|cos|tan|asin|acos|atan)"
        Const Func2 As String = "(atan2)"
        Const FuncN As String = "(min|max)"
        Const Constants As String = "(e|pi)"

        Dim rePower As New Regex(Num & "\s*(\^)s*" & Num)
        Dim reAddSub As New Regex(Num & "\s*([-+])s*" & Num)
        Dim reMulDiv As New Regex(Num & "\s*([*/])s*" & Num)
        Dim reFunc1 As New Regex(Func1 & "\(\s*" & Num & "\s*\)", RegexOptions.IgnoreCase)
        Dim reFunc2 As New Regex(Func2 & "\(\s*" & Num & "\s*,\s*" & Num & "\s*\)", RegexOptions.IgnoreCase)
        Dim reFuncN As New Regex(FuncN & "\((\s*" & Num & "\s*,)+\s*" & Num & "\s*\)", RegexOptions.IgnoreCase)
        Dim reSign1 As New Regex("([-+/*^])\s*\+")
        Dim reSign2 As New Regex("\-\s*\-")
        Dim rePar As New Regex("(?<![A-Za-z0-9])\(\s*([-+]?\d+.?\d*)\s*\)")
        Dim reNum As New Regex("^\s*[-+]?\d+\.?\d*\s*$")
        Dim reConst As New Regex("\s*" & Constants & "\s*", RegexOptions.IgnoreCase)

        expr = reConst.Replace(expr, AddressOf DoConstants)
        Do Until reNum.IsMatch(expr)
            Dim saveExpr As String = expr
            Do While rePower.IsMatch(expr)
                expr = rePower.Replace(expr, AddressOf DoPower)
            Loop
            Do While reMulDiv.IsMatch(expr)
                expr = reMulDiv.Replace(expr, AddressOf DoMulDiv)
            Loop
            Do While reFuncN.IsMatch(expr)
                expr = reFuncN.Replace(expr, AddressOf DoFuncN)
            Loop
            Do While reFunc2.IsMatch(expr)
                expr = reFunc2.Replace(expr, AddressOf DoFunc2)
            Loop
            Do While reFunc1.IsMatch(expr)
                expr = reFunc1.Replace(expr, AddressOf DoFunc1)
            Loop
            expr = reSign1.Replace(expr, "$1")
            expr = reSign2.Replace(expr, "+")
            Do While reAddSub.IsMatch(expr)
                expr = reAddSub.Replace(expr, AddressOf DoAddsub)
            Loop
            expr = rePar.Replace(expr, "$1")
        Loop
        Return CDbl(expr)
    End Function
    Function DoConstants(ByVal m As Match) As String
        Select Case m.Groups(1).Value.ToUpper
            Case "PI"
                Return Math.PI.ToString
            Case "E"
                Return Math.E.ToString
            Case Else
                Return vbNullString
        End Select
    End Function
    Function DoPower(ByVal m As Match) As String
        Dim n1 As Double = CDbl(m.Groups(1).Value)
        Dim n2 As Double = CDbl(m.Groups(3).Value)
        Return (n1 ^ n2).ToString
    End Function
    Function DoMulDiv(ByVal m As Match) As String
        Dim n1 As Double = CDbl(m.Groups(1).Value)
        Dim n2 As Double = CDbl(m.Groups(3).Value)
        Select Case m.Groups(2).Value
            Case "/"
                Return (n1 / n2).ToString
            Case "*"
                Return (n1 * n2).ToString
            Case Else
                Return vbNullString
        End Select
    End Function
    Function DoAddsub(ByVal m As Match) As String
        Dim n1 As Double = CDbl(m.Groups(1).Value)
        Dim n2 As Double = CDbl(m.Groups(3).Value)
        Select Case m.Groups(2).Value
            Case "+"
                Return (n1 + n2).ToString
            Case "-"
                Return (n1 - n2).ToString
            Case Else
                Return vbNullString
        End Select
    End Function
    Function DoFunc1(ByVal m As Match) As String
        Dim n1 As Double = CDbl(m.Groups(2).Value)
        Select Case m.Groups(1).Value.ToUpper
            Case "EXP"
                Return Math.Exp(n1).ToString
            Case "LOG"
                Return Math.Log(n1).ToString
            Case "LOG10"
                Return Math.Log10(n1).ToString
            Case "ABS"
                Return Math.Abs(n1).ToString
            Case "SQR", "SQRT"
                Return Math.Sqrt(n1).ToString
            Case "SIN"
                Return Math.Sin(n1).ToString
            Case "COS"
                Return Math.Cos(n1).ToString
            Case "TAN"
                Return Math.Tan(n1).ToString
            Case "ASIN"
                Return Math.Asin(n1).ToString
            Case "ACOS"
                Return Math.Acos(n1).ToString
            Case "ATAN"
                Return Math.Atan(n1).ToString
            Case Else
                Return vbNullString
        End Select
    End Function
    Function DoFunc2(ByVal m As Match) As String
        Dim n1 As Double = CDbl(m.Groups(2).Value)
        Dim n2 As Double = CDbl(m.Groups(3).Value)
        Select Case m.Groups(1).Value.ToUpper
            Case "ATAN2"
                Return Math.Atan2(n1, n2).ToString
            Case Else
                Return vbNullString
        End Select
    End Function
    Function DoFuncN(ByVal m As Match) As String
        Dim args As New ArrayList()
        Dim i As Integer = 2
        Do While m.Groups(i).Value <> ""
            args.Add(CDbl(m.Groups(i).Value.Replace(","c, " "c)))
            i += 1
        Loop
        Select Case m.Groups(1).Value.ToUpper
            Case "MIN"
                args.Sort()
                Return args(0).ToString
            Case "MAX"
                args.Sort()
                Return args(args.Count - 1).ToString
            Case Else
                Return vbNullString
        End Select
    End Function
End Module