modmath.bas

可以完成2－20次的最小二乘拟合运算

Attribute VB_Name = "ModMath"
Public Function zxec(x() As Double, y() As Double, n As Integer, val1() As Double, m As Integer, val2() As Double) As Integer
    Dim a() As Double
    Dim dt(2) As Double
    Dim i, j, k As Integer
    Dim z, p, c, g, q, d1, d2 As Double
    Dim s(20), b(20), t(20) As Double
    
    ReDim a(m - 1)
    For i = 0 To m - 1 Step 1
        a(i) = 0
    Next i
    
    If m > n Then m = n
    If m > 20 Then m = 20
    
    z = 0
    
    For i = 0 To n - 1 Step 1
        z = z + x(i) / (1 * n)
    Next i
    
    b(0) = 1
    d1 = 1 * n
    p = 0
    c = 0
    For i = 0 To n - 1 Step 1
        p = p + (x(i) - z)
        c = c + y(i)
    Next i
    
    c = c / d1
    p = p / d1
    a(0) = c * b(0)
    If m > 1 Then
        t(1) = 1
        t(0) = -p
        d2 = 0
        c = 0
        g = 0
        For i = 0 To n - 1 Step 1
            q = x(i) - z - p
            d2 = d2 + q * q
            c = c + y(i) * q
            g = g + (x(i) - z) * q * q
        Next i
        c = c / d2
        p = g / d2
        q = d2 / d1
        d1 = d2
        a(1) = c * t(1)
        a(0) = c * t(0) + a(0)
    
    End If
    
    For j = 2 To m - 1 Step 1
        s(j) = t(j - 1)
        s(j - 1) = -p * t(j - 1) + t(j - 2)
        If j >= 3 Then
            For k = j - 2 To 1 Step -1
                s(k) = -p * t(k) + t(k - 1) - q * b(k)
            Next k
        End If
        
        s(0) = -p * t(0) - q * b(0)
        d2 = 0
        c = 0
        g = 0
        For i = 0 To n - 1 Step 1
            q = s(j)
            For k = j - 1 To 0 Step -1
                q = q * (x(i) - z) + s(k)
            Next k
                d2 = d2 + q * q
                c = c + y(i) * q
                g = g + (x(i) - z) * q * q
         Next i
            c = c / d2
            p = g / d2
            q = d2 / d1
            d1 = d2
            a(j) = c * s(j)
            t(j) = s(j)
            For k = j - 1 To 0 Step -1
                a(k) = c * s(k) + a(k)
                b(k) = t(k)
                t(k) = s(k)
            Next k
    Next j
    
    dt(0) = 0
    dt(1) = 0
    dt(2) = 0
    
    For i = 0 To n - 1 Step 1
        q = a(m - 1)
        For k = m - 2 To 0 Step -1
            q = a(k) + q * (x(i) - z)
        Next k
            p = q - y(i)
            If Abs(p) > dt(2) Then dt(2) = Abs(p)
            dt(0) = dt(0) + p * p
            dt(1) = dt(1) + Abs(p)
    Next i

    val1 = a

End Function



Public Function calepoly(a() As Double, x As Double, n As Integer, z As Double) As Double
    Dim sum As Double
    sum = 0
    For i = 0 To n - 1 Step 1
        sum = a(i) * ((x - z) ^ i) + sum
    Next i
    calepoly = sum
End Function