读书人

vb解十元一次方程

发布时间: 2012-12-16 12:02:32 作者: rapoo

vb解10元一次方程
关于最小二乘法的多元线性回归。求回归系数b0-b9。自变量有9个:x1-x9,是用excel导入到VB里的数据,每个自变量有30个数据。因变量y也有30个数据。现在要用VB编写一个程序算出b0-b9,求代码!可以用矩阵来写。http://hi.baidu.com/mfxvlirgqhnsxys/item/4bfae77d7949ea3c7144239c
截图我上传不了,如果对多元线性回归不了解的话可以参考以上网站。谢谢了
[最优解释]
这是我写的,截距为0的时候,比如y=ax*x+bx+c,截距为0的话,那么c=0,截距不为0的时候,可以稍微修改一下下面这个代码


'**************************************************
'过程名称: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 Double

For 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 i

If 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 If

If 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 i

End Sub


[其他解释]
结贴吧,哈哈。保证你可以。。。。
[其他解释]
2L的盆友,如果我有10个未知数(b0,b1...b9),而且方程是一次方程比如Y=b0+b1*x1+b2*x2+.....+b9*x9 要怎么改你的代码啊。非计算机专业的,只是老师布置的作业。求浅显一点的回答,谢谢了
[其他解释]
引用:
2L的盆友,如果我有10个未知数(b0,b1...b9),而且方程是一次方程比如Y=b0+b1*x1+b2*x2+.....+b9*x9 要怎么改你的代码啊。非计算机专业的,只是老师布置的作业。求浅显一点的回答,谢谢了

即使你不是计算机的,老师让你搞这个,你也是在读研的吧,所以这点VB编程,还是要了解一下好。

Function Determinant(ByRef factor) As Single
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 Function

Sub 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


[其他解释]
我运行了一下,超过7个未知数的时候,会有“ Determinant = Determinant * Pivot”这一句显示溢出,还有那个我不是研究生,还在读大学哈。VB在基础课上学过一点,不过内容都太浅,而且太久不用都忘记了。。。目前苦逼自学中
[其他解释]


引用:
结贴吧,哈哈。保证你可以。。。。
结贴了是不是就不能回复了。第一次发帖不太懂
[其他解释]
我代表CSDN向你保证,你赶紧结贴,把分都给我,就还可以回复!
[其他解释]
http://download.csdn.net/detail/veron_04/1627064
[其他解释]
引用:
http://download.csdn.net/detail/veron_04/1627064

为什么打开时说要登录才能阅读
[其他解释]
解一次就要10元!太贵了!
[其他解释]
引用:
解一次就要10元!太贵了!
什么意思

读书人网 >VB

热点推荐