用VB做曲线拟合（该程序适用于磁化曲线的拟合）

eecomes

最小二乘法多次曲线拟合的VB实现
'窗体代码
Option Explicit
'****************************************************************************************************'

'   X()                     Double　实型一维数组，长度为 n 。

存放给定 n 个数据点的　X　坐标。 **
'   Y()－－－－－－Double　实型一维数组，长度为 n 。存放给定 n 个数据点的　Y　坐标。
'   n－－－－－－－Integer 变量。给定数据点的个数。 **
'   a()－－－－－－Double　实型一维数组，长度为 m 。返回 m-1　次拟合多项式的 m 个系数。
'   m－－－－－－－Integer 变量。拟合多项式的项数，即拟合多项式的最高次数为 m-1。
'   要求 m<=n 且m<=20。若 m>n 或 m>20 ，则本函数自动按 m=min{n,20} 处理。
'   rdblAverageX－－Double 变量，返回给定n个数据点的 X 坐标的平均值
'   dt()－－－－－－Double 实型一维数组，长度为 3。其中：
'   dt(0) 返回拟合多项式与数据点误差的平方和；
'   dt(1) 返回拟合多项式与数据点误差的绝对值之和；
'   dt(2) 返回拟合多项式与数据点误差绝对值的最大值。
  
'*****************************************************************************************************'

Public Sub Iapcir(X() As Double, Y() As Double, ByVal n As Integer, ByRef a() As Double, ByVal m As Integer, ByRef rdblAverageX As Double, ByRef dt() As Double)
Dim I As Integer, J As Integer, K As Integer
Dim Z As Double, P As Double, C As Double, G As Double, Q As Double, D1 As Double, D2 As Double
Dim S(19) As Double, T(19) As Double, B(19) As Double
For I = 0 To m - 1
a(I) = 0
Next I
If m > n Then m = n
If m > 20 Then m = 20
Z = 0#
For I = 0 To n - 1
rdblAverageX = rdblAverageX X(I)
Z = Z X(I) / (1# * n)
Next I
rdblAverageX = rdblAverageX / n
B(0) = 1#
D1 = 1# * n
P = 0#
C = 0#
For I = 0 To n - 1
P = P (X(I) - Z)
C = C Y(I)
Next I
C = C / D1
P = P / D1
a(0) = C * B(0)
If m > 1 Then
T(1) = 1#
T(0) = (-1) * P
D2 = 0#
C = 0#
G = 0#
For I = 0 To n - 1
Q = X(I) - Z - P
D2 = D2 Q * Q
C = C Y(I) * Q
G = G (X(I) - Z) * Q * Q
Next I
C = C / D2
P = G / D2
Q = D2 / D1
D1 = D2
a(1) = C * T(1)
a(0) = C * T(0) a(0)
End If
For J = 2 To m - 1
S(J) = T(J - 1)
S(J - 1) = (-1) * P * T(J - 1) T(J - 2)
If J >= 3 Then
For K = J - 2 To 1 Step -1
S(K) = (-1) * P * T(K) T(K - 1) - Q * B(K)
Next K
End If
S(0) = (-1) * P * T(0) - Q * B(0)
D2 = 0#
C = 0#
G = 0#
For I = 0 To n - 1
Q = S(J)
For K = J - 1 To 0 Step -1
Q = Q * (X(I) - Z) S(K)
Next K
D2 = D2 Q * Q
C = C Y(I) * Q
G = G (X(I) - Z) * Q * Q
Next I
C = C / D2
P = G / D2
Q = D2 / D1
D1 = D2
a(J) = C * S(J)
T(J) = S(J)
For K = J - 1 To 0 Step -1
a(K) = C * S(K) a(K)
B(K) = T(K)
T(K) = S(K)
Next K
Next J
dt(0) = 0#
dt(1) = 0#
dt(2) = 0#
For I = 0 To n - 1
Q = a(m - 1)
For K = m - 2 To 0 Step -1
Q = a(K) Q * (X(I) - Z)
Next K
P = Q - Y(I)
If Abs(P) > dt(2) Then
dt(2) = Abs(P)
End If
dt(0) = dt(0) P * P
dt(1) = dt(1) Abs(P)
Next I
End Sub

说明:这是将一段工业数据(不规则曲线)拟合成一条光滑的曲线,Excel有同样的功能,经验证,该过程得到的二次方程比Excel要更准确.

方程:Y = a(0) a(1) * (X - X1) a(2) * (X - X1)^2 …… a(n) * (X - X1)^n

其中X1为X轴上的平均值

验证方法:可以用一组不规则的数据经过该程序得到方程式后,代入你的不规则数得到另一组数据,用Excel来比较这两组数据有何不同.

H60880316

直接用MAHCAD或者MATLAB做曲线拟合不是简单很多吗?
执行程序呢？要别人用，总不能叫别人还要花时间编窗口程序吧。

狂飙

好文章。，我也来看看

gydxjq

我带进vb里，不好用，我VB只是初学,有没有调通的,谢谢告知一下啊

tangshx

我的vb里，不好用

sc病猫

我也没弄懂，楼主再教教吧，最好带上VB窗口

ningjing

辛苦了，楼主。

kingsofter_zl

搞进去试一下看看

xinling

我想问一下，VB里面可不可以输出特性曲线？

xyf805

辛苦了，楼主，有心人哈，谢谢！