lidong007106 发表于 2007-6-29 21:50

求多元回归程序

求多元回归程序!最好是运用VB语言编的,谢谢!:handshake

lidong007106 发表于 2007-7-2 08:58

十万火急

:'( 怎么没有人响应啊!

风花雪月 发表于 2007-7-2 10:57

多元回归的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

lidong007106 发表于 2007-7-5 10:35

谢谢风花雪月

万分感谢!我先研究研究,不懂的地方还请指教!:handshake

lidong007106 发表于 2007-7-5 22:00

回复 #3 风花雪月 的帖子

请问这个程序是基于最小二乘法的吗?各个变量所代表的意思能不能给我介绍一下啊,麻烦你了,谢谢!我正在研究的东西是基于最小二乘法的多元线性或者非线性逐步回归法,由于起步不叫晚所学的还不是很深入,以后还请您多多指教!再次感谢

风花雪月 发表于 2007-7-23 15:19

原帖由 lidong007106 于 2007-7-5 22:00 发表 http://www.chinavib.com/forum/images/common/back.gif
请问这个程序是基于最小二乘法的吗?各个变量所代表的意思能不能给我介绍一下啊,麻烦你了,谢谢!我正在研究的东西是基于最小二乘法的多元线性或者非线性逐步回归法,由于起步不叫晚所学的还不是很深入,以后还 ...

自己读一下吧,程序又不复杂
页: [1]
查看完整版本: 求多元回归程序