vb最小二乘法曲线拟合源代码,2次到4次
x(),y()数组存放采集数据,m为数据个数,希望对大家有用!比excel精度略高,本人已使用N次,好用!xs()存放拟合系数。在4次方拟合过程里,还可以根据xs来决定把系数给谁用。
最好把这些过程定义为模块,这样便于重复调用。
但要注意对变量的申明,以便于调用。如:
Public xs(6),xn1(6) As Double '拟合系数
Public m,xs As Integer
Public Sub qxnh2() '最小二乘曲线拟合y=a+bx+cx^2
Dim b, c, m, n, a(1 To 10, 1 To 10) As Double
Dim i, j, k, d(10) As Double
'm = 14 '9 'm为数据个数
For i = 1 To 10 Step 1
d(i) = 0
Next i
For i = 1 To m Step 1
d(1) = d(1) + x(i)
a(1, 2) = d(1)
d(2) = d(2) + x(i) ^ 2
a(1, 3) = d(2)
d(3) = d(3) + y(i)
a(1, 4) = d(3)
d(4) = d(4) + x(i) ^ 3
a(2, 3) = d(4)
d(5) = d(5) + x(i) * y(i)
a(2, 4) = d(5)
d(6) = d(6) + x(i) ^ 4
a(3, 3) = d(6)
d(7) = d(7) + x(i) ^ 2 * y(i)
a(3, 4) = d(7)
Next i
a(1, 1) = m
a(2, 1) = a(1, 2)
a(2, 2) = a(1, 3)
a(3, 1) = a(1, 3)
a(3, 2) = a(2, 3)
n = 3 'n为行数
m = 4 'm为列数
For k = 1 To n - 1 Step 1
For i = k + 1 To n Step 1
For j = k + 1 To m Step 1
a(i, j) = a(i, j) - a(i, k) * a(k, j) / a(k, k)
Next j
Next i
Next k
z(n) = a(n, m) / a(n, n)
For k = n - 1 To 1 Step -1
z(k) = 0
For j = n To k + 1 Step -1
z(k) = z(k) + a(k, j) * z(j)
Next j
z(k) = (a(k, m) - z(k)) / a(k, k)
Next k
xs(1) = z(1): xs(2) = z(2): xs(3) = z(3): xs(4) = 0
End Sub
Public Sub qxnh3() '最小二乘曲线拟合y=a+bx+cx^2+dx^3
Dim b, c, m, n, a(1 To 10, 1 To 10) As Double
Dim i, j, k, e(20) As Double
m = 14 '6 '9 'm为数据个数
For i = 1 To 20 Step 1
e(i) = 0
Next i
For i = 1 To m Step 1
e(1) = e(1) + x(i)
a(1, 2) = e(1)
e(2) = e(2) + x(i) ^ 2
a(1, 3) = e(2)
e(3) = e(3) + x(i) ^ 3
a(1, 4) = e(3)
e(4) = e(4) + y(i)
a(1, 5) = e(4)
e(5) = e(5) + x(i) ^ 3
a(2, 3) = e(5)
e(6) = e(6) + x(i) ^ 4
a(2, 4) = e(6)
e(7) = e(7) + y(i) * x(i)
a(2, 5) = e(7)
e(8) = e(8) + x(i) ^ 5
a(3, 4) = e(8)
e(9) = e(9) + x(i) ^ 2 * y(i)
a(3, 5) = e(9)
e(10) = e(10) + x(i) ^ 6
a(4, 4) = e(10)
e(11) = e(11) + x(i) ^ 3 * y(i)
a(4, 5) = e(11)
Next i
a(1, 1) = m
a(2, 1) = a(1, 2)
a(2, 2) = a(1, 3)
a(2, 3) = a(1, 4)
a(3, 1) = a(1, 3)
a(3, 2) = a(2, 3)
a(3, 3) = a(2, 4)
a(4, 1) = a(1, 4)
a(4, 2) = a(2, 4)
a(4, 3) = a(3, 4)
n = 4 'n为行数
m = 5 'm为列数
For k = 1 To n - 1 Step 1
For i = k + 1 To n Step 1
For j = k + 1 To m Step 1
a(i, j) = a(i, j) - a(i, k) * a(k, j) / a(k, k)
Next j
Next i
Next k
z(n) = a(n, m) / a(n, n)
For k = n - 1 To 1 Step -1
z(k) = 0
For j = n To k + 1 Step -1
z(k) = z(k) + a(k, j) * z(j)
Next j
z(k) = (a(k, m) - z(k)) / a(k, k)
Next k
xs(1) = z(1): xs(2) = z(2): xs(3) = z(3): xs(4) = z(4)
End Sub
Public Sub qxnh4() '最小二乘曲线拟合y=a+bx+cx^2+dx^3+ex^4
Dim b, c, n, a(1 To 10, 1 To 10) As Double
Dim i, j, k, f(20) As Double
'm = 13 '9 'm为数据个数
For i = 1 To 20 Step 1
f(i) = 0
Next i
For i = 1 To m Step 1
f(1) = f(1) + x(i)
a(1, 2) = f(1)
f(2) = f(2) + x(i) ^ 2
a(1, 3) = f(2)
f(3) = f(3) + x(i) ^ 3
a(1, 4) = f(3)
f(4) = f(4) + x(i) ^ 4
a(1, 5) = f(4)
f(5) = f(5) + y(i)
a(1, 6) = f(5)
f(6) = f(6) + x(i) ^ 5
a(2, 5) = f(6)
f(7) = f(7) + y(i) * x(i)
a(2, 6) = f(7)
f(8) = f(8) + x(i) ^ 6
a(3, 5) = f(8)
f(9) = f(9) + x(i) ^ 2 * y(i)
a(3, 6) = f(9)
f(10) = f(10) + x(i) ^ 7
a(4, 5) = f(10)
f(11) = f(11) + x(i) ^ 3 * y(i)
a(4, 6) = f(11)
f(12) = f(12) + x(i) ^ 8
a(5, 5) = f(12)
f(13) = f(13) + x(i) ^ 4 * y(i)
a(5, 6) = f(13)
Next i
a(1, 1) = m
a(2, 1) = a(1, 2)
a(2, 2) = a(1, 3)
a(2, 3) = a(1, 4)
a(2, 4) = a(1, 5)
a(3, 1) = a(1, 3)
a(3, 2) = a(2, 3)
a(3, 3) = a(2, 4)
a(3, 4) = a(2, 5)
a(4, 1) = a(1, 4)
a(4, 2) = a(2, 4)
a(4, 3) = a(3, 4)
a(4, 4) = a(3, 5)
a(5, 1) = a(1, 5)
a(5, 2) = a(2, 5)
a(5, 3) = a(3, 5)
a(5, 4) = a(4, 5)
n = 5 'n为行数
m = 6 'm为列数
For k = 1 To n - 1 Step 1
For i = k + 1 To n Step 1
For j = k + 1 To m Step 1
a(i, j) = a(i, j) - a(i, k) * a(k, j) / a(k, k)
Next j
Next i
Next k
z(n) = a(n, m) / a(n, n)
For k = n - 1 To 1 Step -1
z(k) = 0
For j = n To k + 1 Step -1
z(k) = z(k) + a(k, j) * z(j)
Next j
z(k) = (a(k, m) - z(k)) / a(k, k)
Next k
If xs = 1 Then
xn1(1) = z(1): xn1(2) = z(2): xn1(3) = z(3): xn1(4) = z(4): xn1(5) = z(5)
End If
If xs = 3 Then
xs(1) = z(1): xs(2) = z(2): xs(3) = z(3): xs(4) = z(4): xs(5) = z(5)
End If
End Sub