多元回归的vb实现
- On Error Resume Next
- Dim x() As Double
- Dim y() As Double
- Dim xz() As Double
- Dim c() As Double
- Dim d() As Double
- Dim a() As Double
- Dim am, bm, cm As Double
- Dim y1() As Double
- ReDim x(m, n)
- ReDim y(m)
- ReDim y1(m)
- ReDim xz(n, m)
- ReDim c(n, 2 * n)
- ReDim d(n, m)
- ReDim a(n)
- For i = 1 To m
- x(i, 1) = 1
- Next i
- For i = 1 To m
- For j = 2 To n
- x(i, j) = VSFGrid1.TextMatrix(i, j - 1)
- Next j
- Next i
- For i = 1 To m
- y(i) = VSFGrid1.TextMatrix(i, n)
- Next i
- 'a=(x'*x)^-1*x'*y
- For i = 1 To n
- For j = 1 To m
- xz(i, j) = x(j, i) '转置
-
- Next j
- Next i
- For i = 1 To n
- For j = 1 To 2 * n
- If j = i + n Then
- c(i, j) = 1
- Else
- c(i, j) = 0
- End If
- Next j
- Next i
- For i = 1 To n
- For j = 1 To n
- For k = 1 To m
- c(i, j) = c(i, j) + xz(i, k) * x(k, j) '求xz()*x()
- Next k
- Next j
- Next i
- For k = 1 To n '用主元除主元所在行的所有元素
- am = 1 / c(k, k) '将主元变为1
- For j = k To 2 * n
- c(k, j) = c(k, j) * am
- Next j
- '____________________________________
- For i = k + 1 To n '将原矩阵变为下三角矩阵
- bm = c(i, k)
- For j = 1 To 2 * n
- c(i, j) = c(i, j) - c(k, j) * bm
- Next j
- Next i
- Next k
- '------------------------------------------------
- For k = 2 To n
- For i = 1 To k - 1 '将下三角矩阵变为单位阵
- cm = c(i, k)
- For j = k To 2 * n
- c(i, j) = c(i, j) - c(k, j) * cm
- Next j
- Next i
- Next k
- '------------------------------------------------
- For i = 1 To n
- For j = 1 To n
- c(i, j) = c(i, j + n)
- Next j
- Next i
- For i = 1 To n
- For j = 1 To m
- For k = 1 To n
- d(i, j) = d(i, j) + c(i, k) * xz(k, j)
- Next k
- Next j
- Next i
- For i = 1 To n
- For j = 1 To m
- a(i) = a(i) + d(i, j) * y(j)
- Next j
- Next i
- For i = 1 To n
- If VSFGrid1.TextMatrix(0, i) = "" Then
- VSFGrid1.TextMatrix(0, i) = "变量" & i
- End If
- Next i
- VSFGrid1.TextMatrix(0, n + 1) = "回归值"
- VSFGrid1.TextMatrix(0, n + 2) = "偏差值"
- For k = 1 To m
- y1(k) = a(1)
- For i = 1 To n - 1
-
- y1(k) = y1(k) + Val(VSFGrid1.TextMatrix(k, i)) * a(i + 1)
- VSFGrid1.TextMatrix(k, n + 1) = y1(k)
- Next i
- Next k
- For k = 1 To m
- VSFGrid1.TextMatrix(k, n + 2) = Val(VSFGrid1.TextMatrix(k, n)) - Val(VSFGrid1.TextMatrix(k, n + 1))
- Next k
- For k = 1 To m
- Dim pfh, ypfh, yp, sz, sh, ss, f, r, bzc As Double
- pfh = pfh + y(k) * y(k)
- ypfh = ypfh + y1(k) * y1(k)
- yp = yp + y(k) / m
- yp = yp * yp
- Next k
- sz = pfh - m * yp
- sh = ypfh - m * yp
- ss = sz - sh
- f = sh / (n - 1) / (ss / (m - n))
- r = (sh / sz) ^ 0.5
复制代码 |