form1.vb

基于vb.net的最小二乘法多项式系数计算类. 很好用,比Excel还精确.

    '         Lfit(): get polynomial coefficients fit
    '         EvaluateX() for get Y given X
    '         EvaluateY() for get X given Y


    ' Also this program use next Classes:

    '*******************
    'GaussJordan Class
    'solve equations systems. In This case is used for solve normal equations
    'properties: aMat:  input coefficients of equations and return 
    '                     inverse matrix when execute gaussj() method 
    '            bVec:  input constants of equations
    '                      and return solution when execute gaussj() method 
    '            Numeq:  input number of equations

    'Methods: gaussj(): solve equations systems

    '*******************
    'Bairstow Class
    'Find reals and complex roots of polynomials for Bairstow's Method
    'used for interpolation: get Y value, given X in polynomial regression
    'Properties:
    '     Degree: input degree of polynomial
    '     Poly: input polynomial 
    '     Roots: store roots
    '     NumRoot: get number of roots of polynomial
    '     Tolerance: precision of calculates
    '     Iterations: Number of iterations 
    'Methods: brstow() : find real and complex roots of polynomial

    'by Adolfo Leon Sepulveda
    'Jan-30-2005
    'Version 1.0
    Dim o As New Object
    Dim PowReg As New PowerRegression
    Dim ExpReg As New ExpRegression
    Dim PolyReg As New PolyRegression
    
    'Power regression y= aX^b
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Button4.Enabled = True
        Button5.Enabled = True
        TextBox1.Text = "Power regression y= aX^b"
        o = CObj(PowReg)
        If Not readData("Data File: RegPowerData.txt on .\bin folder project") Then
            Exit Sub
        End If
        o.Regr()
        PrintPow()
    End Sub
    'Exponential regression y = a e^(bx)
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Button4.Enabled = True
        Button5.Enabled = True
        TextBox1.Text = "Exponential regression y = a e^(bx)"
        o = CObj(ExpReg)
        If Not readData("Data File: RegExpData.txt on .\bin folder project") Then
            Exit Sub
        End If
        o.Regr()
        PrintExp()
    End Sub
    'Polynomial regression Ao +A1x + A2x^2...
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim xStr As String

        Button4.Enabled = True
        Button5.Enabled = True
        TextBox1.Text = "Polynomial regression Ao +A1x + A2x^2..."
        o = CObj(PolyReg)
        If Not readData("Data File: RegPolyData on .\bin folder project") Then
            Exit Sub
        End If
        xStr = InputBox("Enter degree of poly to fit")
        o.DegreePoly = CInt(xStr)
        o.Regr()
        PrintPoly()
    End Sub

    'Interpolation: Given X, get Y
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        o.EvaluateX()
    End Sub
    'Interpolation: Given Y, get X
    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        o.EvaluateY()
    End Sub
    'Read a data file RegPowData.txt, ReaExpData.txt or RegPolyData.txt  
    ' from folder .\bin of project
    Function readData(ByVal s As String) As Boolean
        Dim strx, stry As String
        Dim myStream As Stream
        Dim openFileDialog1 As New OpenFileDialog
        Dim input As String
        Dim i As Integer

        openFileDialog1.Title = s
        openFileDialog1.InitialDirectory = ".\"
        openFileDialog1.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*"
        openFileDialog1.FilterIndex = 2
        openFileDialog1.RestoreDirectory = True

        If Not (openFileDialog1.ShowDialog() = DialogResult.OK) Then
            Return False
        End If
        myStream = openFileDialog1.OpenFile

        If myStream Is Nothing Then
            Return False
        End If
        Dim sr As StreamReader
        sr = File.OpenText(openFileDialog1.FileName)

        i = 1
        Do
            input = sr.ReadLine()
            If InStr(input, "'") <> 0 Or input Is Nothing Then Exit Do
            strx = Mid(input, 1, InStr(input, ",") - 1)
            stry = Mid(input, InStr(input, ",") + 1, InStrRev(input, ",") + 1)
            o.xVec(i) = CDbl(strx)
            o.yVec(i) = CDbl(stry)
            i += 1
        Loop Until input Is Nothing
        o.NumData = i - 1
        myStream.Close()
        Return True
    End Function
    'print power regression fit and data points
    Public Sub PrintPow()
        Dim c, s, z, xTemp, yTemp As Double
        Dim i As Integer

        c = Exp(o.bVec(1))

        TextBox1.AppendText(vbCrLf & "y=" & Format(c, "0.000") & " x^" & Format(o.bVec(2), "0.000"))
        TextBox1.AppendText(vbCrLf)

        s = 0
        TextBox1.AppendText("        x         y          Fit")
        For i = 1 To o.NumData()
            xTemp = Exp(o.xVec(i)) ' return to original points
            yTemp = Exp(o.yVec(i))
            z = c * xTemp ^ o.bVec(2)
            s = s + (yTemp - z) ^ 2
            TextBox1.AppendText(vbCrLf)
            TextBox1.AppendText(Format(xTemp, "0.000") & " " & _
                                Format(yTemp, "0.000") & " " & _
                                Format(z, "0.000"))
        Next i
        TextBox1.AppendText(vbCrLf)
        TextBox1.AppendText("Chi2: " & Format(s, "0.0000"))
    End Sub
    'print exponential regression fit and data points
    Public Sub PrintExp()

        Dim c, s, z, xTemp, yTemp As Double
        Dim i As Integer

        c = Exp(o.bVec(1))
        TextBox1.AppendText(vbCrLf & "y=" & Format(c, "0.000") & " exp(" & Format(o.bVec(2), "0.000") & "x)")
        TextBox1.AppendText(vbCrLf)
        ' return original y points
        For i = 1 To o.NumData()
            o.yVec(i) = Exp(o.yVec(i))
        Next i
        s = 0
        TextBox1.AppendText("        x          y           Fit")
        For i = 1 To o.NumData()
            z = c * Exp(o.bVec(2) * o.xVec(i))
            s = s + (o.yVec(i) - z) ^ 2
            TextBox1.AppendText(vbCrLf)
            TextBox1.AppendText(Format(o.xVec(i), "0.000") & "  " & _
                                Format(o.yVec(i), "0.000") & "  " & _
                                Format(z, "0.000"))
        Next i
        TextBox1.AppendText(vbCrLf)
        TextBox1.AppendText("Chi2: " & Format(s, "0.0000"))
    End Sub
    'print polynomial regression fit and data points
    Public Sub PrintPoly()
        Dim s, z, xTemp, yTemp As Double
        Dim i, j As Integer
        'print polynomial
        PrintPolynomial(o.bVec, o.DegreePoly)
        s = 0
        'print data points and fits
        TextBox1.AppendText("        x          y           Fit")
        For i = 1 To o.NumData
            z = o.bVec(1)
            For j = 2 To o.DegreePoly + 1
                z = z + o.bVec(j) * o.xVec(i) ^ (j - 1)
            Next j
            s = s + (o.yVec(i) - z) ^ 2
            TextBox1.AppendText(vbCrLf)
            TextBox1.AppendText(Format(o.xVec(i), "0.000") & "  " & _
                                Format(o.yVec(i), "0.000") & "  " & _
                                Format(z, "0.000"))
        Next i
        TextBox1.AppendText(vbCrLf)
        TextBox1.AppendText("Chi2: " & Format(s, "0.0000"))
    End Sub
    'print a polynomial of the form Ao +A1x + A2x^2 + A3x^3 ...
    Sub PrintPolynomial(ByVal b() As Double, ByVal n As Integer)
        Dim i As Integer
        TextBox1.AppendText(vbCrLf)

        If b(2) >= 0 Then
            TextBox1.AppendText(vbCrLf & "y= " & Format(b(1), "0.000") & " + " & _
                                                 Format(b(2), "0.000") & "x")
        Else
            TextBox1.AppendText("y= " & Format(b(1), "0.000") & " - " & _
                                        Format(Abs(b(2)), "0.000") & "x")
        End If
        If n + 1 > 2 Then
            For i = 3 To n + 1
                If b(i) >= 0 Then
                    TextBox1.AppendText(" + " & Format(b(i), "0.000") & "x^" & i - 1)
                Else
                    TextBox1.AppendText(" - " & Format(Abs(b(i)), "0.000") & "x^" & i - 1)
                End If
            Next i
        End If
        TextBox1.AppendText(vbCrLf)
        TextBox1.AppendText(vbCrLf)
    End Sub

End Class