一元非线性m2.bas

这是一个有关概率中的回归分析算法,内有多种算法,欢迎大家使用.

Attribute VB_Name = "modMethod"
Option Explicit
'一元非线性
'x(1 To n)：自变量，n为观测次数
'y(1 To n)：因变量，n为观测次数
'b0：截距，计算结果
'b1：回归系数，计算结果
'R2：拟合指数，计算结果
Public Sub LinR2(x() As Double, y() As Double, b0 As Single, b1 As Single, _
                R2 As Double)
    Dim Xa As Double, Ya As Double, Sxx As Double, Sxy As Double, Syy As Double
    Dim SSR As Double, SSE As Double
    Dim Syx2 As Double, Sb As Double, Sb2 As Double, Sx As Double
    Dim n As Integer, I As Integer
    On Error Resume Next
    n = UBound(x, 1)
    For I = 1 To n
        Xa = Xa + x(I): Ya = Ya + y(I)
    Next I
    Xa = Xa / n: Ya = Ya / n                        '平均值
    For I = 1 To n
        Sxx = Sxx + (x(I) - Xa) ^ 2
        Sxy = Sxy + (x(I) - Xa) * (y(I) - Ya)
        Syy = Syy + (y(I) - Ya) ^ 2
    Next I
    b1 = Sxy / Sxx                                  '截距
    b0 = Ya - b1 * Xa                               '回归系数
'总方差
'Ya为因变量的平均值
    For I = 1 To n
        SSR = SSR + (Ya - b0 - b1 * x(I)) ^ 2
    Next I
'由剩余所导致的方差
'y(I)为因变量的观测值
    For I = 1 To n
        SSE = SSE + (y(I) - b0 - b1 * x(I)) ^ 2
    Next I
'拟合指数
    R2 = 1 - SSE / SSR
End Sub

'计算函数值
Public Sub ReCul(b0 As Single, b1 As Single, K As Integer, _
        x As Double, y As Double)
'*****
    Select Case K
        Case 1
            y = b0 + b1 * x                     '线性
        Case 2
            y = b0 + b1 / x                     '双曲线(1)
        Case 3
            y = 1 / (b0 + b1 / x)               '双曲线(2)
        Case 4
            y = b0 + b1 * Log(x)                'X对数
        Case 5
            y = Exp(b0 + b1 * x)                'Y对数
        Case 6
            y = Exp(b0 + b1 * Log(x))           '双对数
        Case 7
            y = 1 / (b0 + b1 * Exp(-x))         'S型
        Case 8
            y = b0 + b1 * Sqr(x)                'X平方根
        Case 9
            y = (b0 + b1 * x) ^ 2               'Y平方根
        Case 10
            y = (b0 + b1 * Sqr(x)) ^ 2          '双平方根
    End Select
'*****
End Sub