关于最小二乘法的多元线性回归。求回归系数b0-b9。自变量有9个：x1-x9，是用excel导入到VB里的数据，每个自变量有30个数据。因变量y也有30个数据。现在要用VB编写一个程序算出b0-b9，求代码！可以用矩阵来写。http://hi.baidu.com/mfxvlirgqhnsxys/item/4bfae77d7949ea3c7144239c
截图我上传不了，如果对多元线性回归不了解的话可以参考以上网站。谢谢了
截图我上传不了，如果对多元线性回归不了解的话可以参考以上网站。谢谢了
'过程名称：LeastSquare2 ,截距强制为0.
'过程功能：解三次方程式
'入口参数：arrX() ------------- 无因次后的测量值
' arrY(() ------------- 无因次后的输入压力点值
' length -------------- 标定点数
' d ---------------方程最高次数
'出口参数：ReturnCoeff() --- 返回的N次方程系数
'作者：by 孔苏群 2012-11-19
'**************************************************
Public Sub LeastSquare2(arrX() As Double, arrY() As Double, length As Long, ReturnCoeff() As Double, d As Long)
Dim i As Long
Dim j As Long
Dim n As Long
n = d + 1
m = d + 2
Dim Guass() As Double
ReDim Guass(0 To n - 1, 0 To m - 1)
For i = 0 To n - 1
For j = 1 To n - 1 ’如果要截距不为0，那么这里修改为For j=0开始循环
Guass(i, j) = SumArr1(arrX, j + i, length)
Next j
Guass(i, j) = SumArr2(arrX, i, arrY, 1, length)
Next i
Call ComputGauss(Guass, n, ReturnCoeff)
End Sub
'求和运算
'作者：by 孔苏群 2012-11-19
'**************************************************
Function SumArr1(arr() As Double, n As Long, length As Long) As Double
Dim s As Double
Dim i As Double
s = 0
For i = 0 To length - 1
If arr(i) <> 0 Or n <> 0 Then
s = s + arr(i) ^ n
Else
s = s + 1
End If
Next i
SumArr1 = s
End Function
'求平方和运算
Function SumArr2(arr1() As Double, n1 As Long, arr2() As Double, n2 As Long, length As Long) As Double
Dim s As Double
Dim i As Double
s = 0
For i = 0 To length - 1
If (arr1(i) <> 0 Or n1 <> 0) And (arr2(i) <> 0 Or n2 <> 0) Then
s = s + arr1(i) ^ n1 * arr2(i) ^ n2
Else
s = s + 1
End If
Next
SumArr2 = s
End Function'作者：by 孔苏群 2012-11-19
'**************************************************
Public Sub ComputGauss(Guass() As Double, n As Long, X() As Double)
Dim i As Long, k As Long, m As Long
Dim j As Long
Dim Temp As Double
Dim max As Double
Dim s As DoubleFor j = 1 To n - 1 '如果截距不为0 这里从For j=0开始循环
max = 0
k = j
For i = j To n - 1
If Abs(Guass(i, j) > max) Then
max = Guass(i, j)
k = i
End If
Next iIf k <> j Then
For m = j To n
Temp = Guass(j, m)
Guass(j, m) = Guass(k, m)
Guass(k, m) = Temp
Next m
End IfIf max = 0 Then
CompitGuass = X
End If
'dsdss
For i = j + 1 To n - 1
s = Guass(i, j)
For m = j To n
Guass(i, m) = Guass(i, m) - Guass(j, m) * s / (Guass(j, j))
Next m
Next i
Next j
For i = n - 1 To 1 Step -1
s = 0
For j = i + 1 To n - 1
s = s + Guass(i, j) * X(j)
Next j
X(i) = (Guass(i, n) - s) / Guass(i, i)
Next iEnd Sub
Dim i As Long, j As Long, k As Long, row As Long, order As Long
Dim r As Long, c As Long, Pivot As Single, Pivot2 As Single, temp() As Single
Determinant = 1
Dim m
m = factor
row = UBound(m, 1)
If Not UBound(m, 2) = row + 1 Then MsgBox "无解或不定解！": Exit Function
ReDim temp(1 To row)
For i = 1 To row
Pivot = 0
For j = i To row
For k = i To row
If Abs(m(k, j)) > Pivot Then
Pivot = Abs(m(k, j))
r = k: c = j
End If
Next k
Next j
If Pivot = 0 Then Determinant = 0: Exit Function
If r <> i Then
order = order + 1
For j = 1 To row
temp(j) = m(i, j)
m(i, j) = m(r, j)
m(r, j) = temp(j)
Next j
End If
If c <> i Then
order = order + 1
For j = 1 To row
temp(j) = m(j, i)
m(j, i) = m(j, c)
m(j, c) = temp(j)
Next j
End If
Pivot = m(i, i)
Determinant = Determinant * Pivot
For j = i + 1 To row
Pivot2 = m(j, i)
If Pivot2 <> 0 Then
For k = 1 To row
m(j, k) = m(j, k) - m(i, k) * Pivot2 / Pivot
Next
End If
Next
Next
Determinant = Determinant * (-1) ^ order
End FunctionSub getresult(ByRef factor(), ByRef answer As String)
Dim row As Integer, i As Integer, D0 As Single
Dim m
Dim result() As String
row = UBound(factor, 1)
ReDim result(1 To row)
D0 = Determinant(factor)
If D0 = 0 Then MsgBox "无解！": Exit Sub
For i = 1 To row
m = factor
For j = 1 To row
m(j, i) = factor(j, row + 1)
Next
result(i) = "X" & i & "= " & Format(Determinant(m) / D0, "0.00") ' Di/D0
Next
answer = Join(result, vbCrLf)
End Sub
'以下是你10个点，比如你的那30组数据。
Private Sub Command1_Click()
Dim Param(3, 4) ' 三元一次方程组，如果是9元一次，这里就是Dim Param(9,10)
Dim i As Integer
For i = 1 To 4
Param(1, i) = Choose(i, 1, 1, 1, 6) ' x1+x2+x3=6, 这里对照你自己的改成9元的，x1,x2....x9
Param(2, i) = Choose(i, 2, -1, 3, 5) ' 2x1-x2+3x3=5
Param(3, i) = Choose(i, 4, 2, -3, 3) '4x1+2x2-3x3=3
Next
Dim answer As String
getresult Param, answer
MsgBox answer, 0, "答案"
End Sub