| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3554 人关注过本帖
标题:vb最小二乘法曲线拟合源代码,2次到4次
只看楼主 加入收藏
pengzihan
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2011-4-28
结帖率:0
收藏
 问题点数:0 回复次数:2 
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
搜索更多相关主题的帖子: 源代码 excel 
2011-05-22 22:56
vseeder01
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2015-6-26
收藏
得分:0 
  楼主在不  我想交你这个朋友
2015-06-30 10:13
cuituo
Rank: 2
等 级:论坛游民
威 望:2
帖 子:28
专家分:22
注 册:2008-6-21
收藏
得分:0 
运行后感觉不大正常呢。经测试和解方程差不多,各点都在拟合的方程中。
2022-04-23 13:58
快速回复:vb最小二乘法曲线拟合源代码,2次到4次
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.016745 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved