VB.net 随机数学表达式生成和计算函数

Imports System.Text.RegularExpressions

Public Class Form1
    Dim rand As Random = New Random()
    Dim t As New List(Of String)
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load


        t.Add("$+$")
        t.Add("$-$")
        t.Add("$*$")
        t.Add("$/$")
        t.Add("($+$)")
        t.Add("($-$)")
        t.Add("$+$")
        t.Add("$-$")
        t.Add("$*$")
        t.Add("$/$")
        t.Add("($+$)")
        t.Add("($-$)")
        t.Add("$+$")
        t.Add("$-$")
        t.Add("$*$")
        t.Add("$/$")
        t.Add("($+$)")
        t.Add("($-$)")
        t.Add("$+$")
        t.Add("$-$")
        t.Add("$*$")
        t.Add("$/$")
        t.Add("($+$)")
        t.Add("($-$)")
        t.Add("sin($)")
        t.Add("cos($)")
        t.Add("tan($)")
        t.Add("sqr($)")
        t.Add("abs($)")
        t.Add("exp($)")





    End Sub

    Public Function getfuhao(s As String, tihuan As String)
        Dim fuhaoweizhi As New List(Of Integer)
        For i = 0 To s.Count - 1
            If s(i) = "$" Then
                fuhaoweizhi.Add(i)
            End If
        Next
        Dim fuhaoindex = fuhaoweizhi(rand.Next(0, fuhaoweizhi.Count))
        Dim L = Strings.Left(s, fuhaoindex)
        Dim R = Strings.Right(s, s.Length - fuhaoindex - 1)
        '        Debug.Print($"fuhao={fuhaoindex}，{L}{tihuan}{R}")
        Return $"{L}{tihuan}{R}"
    End Function


    Public Function calc(exp)

        Try
            Dim t As Type = Type.GetTypeFromProgID("MSScriptControl.ScriptControl")
            Dim obj As Object = Activator.CreateInstance(t)
            t.InvokeMember("Language", System.Reflection.BindingFlags.SetProperty,
                       Nothing, obj, New Object() {"vbscript"})
            Dim result As Object = t.InvokeMember("Eval", System.Reflection.BindingFlags.InvokeMethod,
                                             Nothing, obj, New Object() {exp})
            Return CStr(result)
        Catch ex As Exception
            Return "错误无法计算"
        End Try


    End Function
    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

    Private Sub 清空ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 清空ToolStripMenuItem.Click
        shuju.Items.Clear()
    End Sub

    Private Sub 生成ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 生成ToolStripMenuItem.Click
        Dim 数量 = 100
        While shuju.Items.Count < 数量
            Dim S = t(rand.Next(0, 6))
            For i = 0 To 40
                S = getfuhao(S, t(rand.Next(0, t.Count)))
            Next
            '  Debug.Print(S)
            While InStr(S, "$")
                S = Strings.Replace(S, "$", rand.Next(1, 10), 1, 1)
            End While
            Dim ret = calc(S)
            If ret <> "错误无法计算" Then
                shuju.Items.Add(New ListViewItem({S, ret}))
            End If
        End While

    End Sub
End Class