那位大侠有用最小二乘法拟合一元高次方程的vb程序代码?
来源:学生作业帮 编辑:大师作文网作业帮 分类:综合作业 时间:2024/09/22 14:42:37
那位大侠有用最小二乘法拟合一元高次方程的vb程序代码?
用最小二乘法拟合一元三次或者四次曲线,相应的有四个或者五个系数需要被计算出来.比如像b=B0+B1xPe+B2xPe^2+B3xPe^3+B4xPe^4.需要计算出B0、B1、B2、B3、B4.这已是我全部的财富了,大侠们帮帮忙吧!
用最小二乘法拟合一元三次或者四次曲线,相应的有四个或者五个系数需要被计算出来.比如像b=B0+B1xPe+B2xPe^2+B3xPe^3+B4xPe^4.需要计算出B0、B1、B2、B3、B4.这已是我全部的财富了,大侠们帮帮忙吧!
Dim pre As Integer
Dim j As Integer
Dim a() As TextBox
Dim b() As TextBox
Sub GS(a() As Single, i0 As Integer, j0 As Integer)
On Error Resume Next
Dim i, j As Integer
Dim k As Single
For i = i0 + 1 To 5
If a(i0, j0) 0 Then
k = a(i, j0) / a(i0, j0)
Else
For row = i0 + 1 To 5
If a(row, j0) 0 Then
Exit For
End If
Next row
For Index = 0 To 6
tmp = a(i0, Index)
a(i0, Index) = a(row, Index)
a(row, Index) = tmp
Next Index
End If
For j = j0 To 6
If k 0 Then
a(i, j) = a(i, j) - k * a(i0, j)
Else
Exit For
End If
Next j
Next i
If i0 >= 4 Then
Exit Sub
End If
Call GS(a, i0 + 1, j0 + 1)
End Sub
Function xyn(x() As TextBox, y() As TextBox, n As Integer, length As Integer) As Single
Dim sum As Single
sum = 0#
For i = 1 To length
sum = sum + Val(x(i).Text) ^ n * Val(y(i).Text)
Next i
xyn = sum
End Function
Function xn(ByRef x() As TextBox, n As Integer, length As Integer) As Single
Dim i As Integer
Dim sum As Single
sum = 0#
For i = 1 To length
sum = sum + Val(x(i).Text) ^ n
Next i
xn = sum
End Function
Private Sub Command1_Click()
On Error Resume Next
Dim s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14 As Single
Dim x0, x1, x2, x3, x4 As Single
Dim mtr(4, 5) As Single
s1 = xn(a, 0, Val(num.Text))
s2 = xn(a, 1, Val(num.Text))
s3 = xn(a, 2, Val(num.Text))
s4 = xn(a, 3, Val(num.Text))
s5 = xn(a, 4, Val(num.Text))
s6 = xn(a, 5, Val(num.Text))
s7 = xn(a, 6, Val(num.Text))
s8 = xn(a, 7, Val(num.Text))
s9 = xn(a, 8, Val(num.Text))
s10 = xyn(a, b, 0, Val(num.Text))
s11 = xyn(a, b, 1, Val(num.Text))
s12 = xyn(a, b, 2, Val(num.Text))
s13 = xyn(a, b, 3, Val(num.Text))
s14 = xyn(a, b, 4, Val(num.Text))
mtr(0, 0) = s1
mtr(1, 0) = s2
mtr(2, 0) = s3
mtr(3, 0) = s4
mtr(4, 0) = s5
mtr(0, 1) = s2
mtr(1, 1) = s3
mtr(2, 1) = s4
mtr(3, 1) = s5
mtr(4, 1) = s6
mtr(0, 2) = s3
mtr(1, 2) = s4
mtr(2, 2) = s5
mtr(3, 2) = s6
mtr(4, 2) = s7
mtr(0, 3) = s4
mtr(1, 3) = s5
mtr(2, 3) = s6
mtr(3, 3) = s7
mtr(4, 3) = s8
mtr(0, 4) = s5
mtr(1, 4) = s6
mtr(2, 4) = s7
mtr(3, 4) = s8
mtr(4, 4) = s9
mtr(0, 5) = s10
mtr(1, 5) = s11
mtr(2, 5) = s12
mtr(3, 5) = s13
mtr(4, 5) = s14
Call GS(mtr, 0, 0)
If mtr(4, 4) = 0 Then
x4 = 1
Else
x4 = mtr(4, 5) / mtr(4, 4)
End If
If mtr(3, 3) = 0 Then
x3 = 1
Else
x3 = (mtr(3, 5) - mtr(3, 4) * x4) / mtr(3, 3)
End If
If mtr(2, 2) = 0 Then
x2 = 1
Else
x2 = (mtr(2, 5) - mtr(2, 4) * x4 - mtr(2, 3) * x3) / mtr(2, 2)
End If
If mtr(1, 1) = 0 Then
x1 = 1
Else
x1 = (mtr(1, 5) - mtr(1, 4) * x4 - mtr(1, 3) * x3 - mtr(1, 2) * x2) / mtr(1, 1)
End If
If mtr(0, 0) = 0 Then
x0 = 1
Else
x0 = (mtr(0, 5) - mtr(0, 4) * x4 - mtr(0, 3) * x3 - mtr(0, 2) * x2 - mtr(0, 1) * x1) / mtr(0, 0)
End If
B0.Text = x0
B1.Text = x1
B2.Text = x2
B3.Text = x3
B4.Text = x4
End Sub
Private Sub num_Change()
On Error Resume Next
'If Val(num.Text) < pre Then
For k = 0 To pre
Form1.Controls.Remove ("Tex" & k)
Next k
'End If
ReDim a(1 To Val(num.Text))
ReDim b(1 To Val(num.Text))
For i = 1 To Val(num.Text)
Set a(i) = Form1.Controls.Add("VB.TextBox", "Tex" & j)
a(i).Visible = True
a(i).Move 840, 1300 + i * 500, 1815, 360
a(i).Text = "输入X坐标"
Set b(i) = Form1.Controls.Add("VB.TextBox", "Tex" & (j + 1))
b(i).Visible = True
b(i).Move 2880, 1300 + i * 500, 1815, 360
b(i).Text = "输入Y坐标"
j = j + 2
Next i
pre = j
j = 0
End Su
Dim j As Integer
Dim a() As TextBox
Dim b() As TextBox
Sub GS(a() As Single, i0 As Integer, j0 As Integer)
On Error Resume Next
Dim i, j As Integer
Dim k As Single
For i = i0 + 1 To 5
If a(i0, j0) 0 Then
k = a(i, j0) / a(i0, j0)
Else
For row = i0 + 1 To 5
If a(row, j0) 0 Then
Exit For
End If
Next row
For Index = 0 To 6
tmp = a(i0, Index)
a(i0, Index) = a(row, Index)
a(row, Index) = tmp
Next Index
End If
For j = j0 To 6
If k 0 Then
a(i, j) = a(i, j) - k * a(i0, j)
Else
Exit For
End If
Next j
Next i
If i0 >= 4 Then
Exit Sub
End If
Call GS(a, i0 + 1, j0 + 1)
End Sub
Function xyn(x() As TextBox, y() As TextBox, n As Integer, length As Integer) As Single
Dim sum As Single
sum = 0#
For i = 1 To length
sum = sum + Val(x(i).Text) ^ n * Val(y(i).Text)
Next i
xyn = sum
End Function
Function xn(ByRef x() As TextBox, n As Integer, length As Integer) As Single
Dim i As Integer
Dim sum As Single
sum = 0#
For i = 1 To length
sum = sum + Val(x(i).Text) ^ n
Next i
xn = sum
End Function
Private Sub Command1_Click()
On Error Resume Next
Dim s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14 As Single
Dim x0, x1, x2, x3, x4 As Single
Dim mtr(4, 5) As Single
s1 = xn(a, 0, Val(num.Text))
s2 = xn(a, 1, Val(num.Text))
s3 = xn(a, 2, Val(num.Text))
s4 = xn(a, 3, Val(num.Text))
s5 = xn(a, 4, Val(num.Text))
s6 = xn(a, 5, Val(num.Text))
s7 = xn(a, 6, Val(num.Text))
s8 = xn(a, 7, Val(num.Text))
s9 = xn(a, 8, Val(num.Text))
s10 = xyn(a, b, 0, Val(num.Text))
s11 = xyn(a, b, 1, Val(num.Text))
s12 = xyn(a, b, 2, Val(num.Text))
s13 = xyn(a, b, 3, Val(num.Text))
s14 = xyn(a, b, 4, Val(num.Text))
mtr(0, 0) = s1
mtr(1, 0) = s2
mtr(2, 0) = s3
mtr(3, 0) = s4
mtr(4, 0) = s5
mtr(0, 1) = s2
mtr(1, 1) = s3
mtr(2, 1) = s4
mtr(3, 1) = s5
mtr(4, 1) = s6
mtr(0, 2) = s3
mtr(1, 2) = s4
mtr(2, 2) = s5
mtr(3, 2) = s6
mtr(4, 2) = s7
mtr(0, 3) = s4
mtr(1, 3) = s5
mtr(2, 3) = s6
mtr(3, 3) = s7
mtr(4, 3) = s8
mtr(0, 4) = s5
mtr(1, 4) = s6
mtr(2, 4) = s7
mtr(3, 4) = s8
mtr(4, 4) = s9
mtr(0, 5) = s10
mtr(1, 5) = s11
mtr(2, 5) = s12
mtr(3, 5) = s13
mtr(4, 5) = s14
Call GS(mtr, 0, 0)
If mtr(4, 4) = 0 Then
x4 = 1
Else
x4 = mtr(4, 5) / mtr(4, 4)
End If
If mtr(3, 3) = 0 Then
x3 = 1
Else
x3 = (mtr(3, 5) - mtr(3, 4) * x4) / mtr(3, 3)
End If
If mtr(2, 2) = 0 Then
x2 = 1
Else
x2 = (mtr(2, 5) - mtr(2, 4) * x4 - mtr(2, 3) * x3) / mtr(2, 2)
End If
If mtr(1, 1) = 0 Then
x1 = 1
Else
x1 = (mtr(1, 5) - mtr(1, 4) * x4 - mtr(1, 3) * x3 - mtr(1, 2) * x2) / mtr(1, 1)
End If
If mtr(0, 0) = 0 Then
x0 = 1
Else
x0 = (mtr(0, 5) - mtr(0, 4) * x4 - mtr(0, 3) * x3 - mtr(0, 2) * x2 - mtr(0, 1) * x1) / mtr(0, 0)
End If
B0.Text = x0
B1.Text = x1
B2.Text = x2
B3.Text = x3
B4.Text = x4
End Sub
Private Sub num_Change()
On Error Resume Next
'If Val(num.Text) < pre Then
For k = 0 To pre
Form1.Controls.Remove ("Tex" & k)
Next k
'End If
ReDim a(1 To Val(num.Text))
ReDim b(1 To Val(num.Text))
For i = 1 To Val(num.Text)
Set a(i) = Form1.Controls.Add("VB.TextBox", "Tex" & j)
a(i).Visible = True
a(i).Move 840, 1300 + i * 500, 1815, 360
a(i).Text = "输入X坐标"
Set b(i) = Form1.Controls.Add("VB.TextBox", "Tex" & (j + 1))
b(i).Visible = True
b(i).Move 2880, 1300 + i * 500, 1815, 360
b(i).Text = "输入Y坐标"
j = j + 2
Next i
pre = j
j = 0
End Su
VB最小二乘法拟合直线
matlab最小二乘法多项式拟合,求程序代码以及结果!
用VB编程求解一个一元高次方程,求代码
用MATLAB进行线性拟合的程序代码
matlab拟合方程:按照其已知方程求解系数,还是用matlab的多项式、最小二乘法拟合新方程
matlab 最小二乘法 平面拟合的代码
解四元三次方程组,最小二乘法拟合面时用的
matlab的问题 最小二乘法拟合曲线
用matlab编写程序:生成一组[1,3]之间的均匀随机数,采用最小二乘法进行5次多项式拟合
那位大侠知道《活了100万次的猫》中的好词好句?
如何在matlab里使用最小二乘法拟合直线方程
MATLAB的拟合函数polyfit 的程序代码是什么啊