VB写的最小二乘法曲线拟合8页

1、Option ExplicitDim x() As Double, y() As DoubleDim A(20, 20) As Double, M As Double, B() As Double 最多取20次的拟合Dim N As Double, I As Double, j As DoubleDim xiaoA() As DoubleDim Xmin As Double, Xmax As DoubleDim Ymin As Double, Ymax As DoubleDim X0pos As Double, Y0pos As DoubleDim xmaxpos As Double, yma

2、xpos As DoubleDim xstep As Double, ystep As DoubleDim xl As Double, yl As DoubleDim xbc As Double, ybc As DoubleDim bc As DoubleDim Xh As DoublePrivate Sub HuaZuoBiao(x() As Double, y() As Double)ReDim xpos(I) As DoubleReDim ypos(I) As DoubleReDim x(I), y(I)X0pos = Width * 0.25 坐标原点最左点Y0pos = Height

3、 * 0.75 坐标原点最低点xmaxpos = Width * 0.85 坐标最右点ymaxpos = Height * 0.15 坐标最高点xstep = (xmaxpos - X0pos) / (Xmax - Xmin) 对应X轴上单位长度代表的屏幕宽度值ystep = (ymaxpos - Y0pos) / (Ymax - Ymin) 对应Y轴上单位长度代表的屏幕高度值在屏幕上画直角坐标系ForeColor = vbBlueLine (Width * 0.1, Y0pos)-(Width * 0.9, Y0pos) 画X坐标轴,从左10%，到右的90%处Line (X0pos, Hei

4、ght * 0.1)-(X0pos, Height * 0.9) 画y坐标轴,从上10%，到下的90%处Font.Size = 20 指定X轴，Y轴标志的字体大小CurrentX = Width * 0.9CurrentY = Y0pos + 100Print X 在横线上画X轴标志 在横线上画X轴箭头标志CurrentX = Width * 0.9CurrentY = Y0posLine (CurrentX - 200, CurrentY - 50)-(CurrentX, CurrentY)Line (CurrentX, CurrentY)-(CurrentX - 200, CurrentY

5、 + 50)CurrentX = X0pos - 500CurrentY = Height * 0.1Print y 在纵线上画Y轴标志 在纵线上画Y轴箭头标志CurrentX = X0posCurrentY = Height * 0.1Line (CurrentX - 50, CurrentY + 200)-(CurrentX, CurrentY)Line (CurrentX, CurrentY)-(CurrentX + 50, CurrentY + 200)CurrentX = X0pos + 200 此为Y轴左边500绝对坐标处CurrentY = Y0pos + 400 取当前Y轴上的

6、相对坐标值Print f=f(x) 在Y轴左边500绝对坐标处对应显示Y轴相对坐标刻度值xl = Xmax - Xminyl = Ymax - YminIf xl 0.01 Then xbc = 0.001ElseIf xl = 0.1 Then xbc = 0.01ElseIf xl = 2 Then xbc = 0.1ElseIf xl = 20 Then xbc = 1ElseIf xl = 120 Then xbc = 10ElseIf xl = 1000 Then xbc = 100ElseIf xl = 10000 Then xbc = 1000Else xbc = 10000En

7、d IfIf yl 0.01 Then ybc = 0.001ElseIf yl = 0.1 Then ybc = 0.01ElseIf yl = 2 Then ybc = 0.1ElseIf yl = 20 Then ybc = 1ElseIf yl = 120 Then ybc = 10ElseIf yl = 1000 Then ybc = 100ElseIf yl = 10000 Then ybc = 1000Else ybc = 10000End If For bc = Xmin To Xmax Step xbcIf bc = Xmax Thenx(j) = bc X轴上的相对坐标值x

8、pos(j) = X0pos + (x(j) - Xmin) * xstepLine (xpos(j), Y0pos)-(xpos(j), ymaxpos), vbRed 画垂直于X轴的刻度线，只画了100个绝对尺寸ElseEnd IfFont.Size = 10 指定X轴，Y轴坐标刻度值的字体大小CurrentX = xpos(j) - 200 取当前X轴上的相对坐标值CurrentY = Y0pos + 100 此为X轴下方100绝对坐标处Print x(j) 在X轴下方100绝对坐标处对应显示X轴相对坐标刻度值Next bcFor bc = Ymin To Ymax Step ybcIf

9、 bc = Ymax Theny(j) = bc X轴上的相对坐标值ypos(j) = Y0pos + (y(j) - Ymin) * ystepLine (X0pos, ypos(j)-(xmaxpos, ypos(j), vbRed 画垂直于X轴的刻度线，只画了100个绝对尺寸ElseEnd IfFont.Size = 10 指定X轴，Y轴坐标刻度值的字体大小CurrentX = X0pos - 500 取当前X轴上的相对坐标值CurrentY = ypos(j) - 100 此为X轴下方100绝对坐标处Print y(j) 在X轴下方100绝对坐标处对应显示X轴相对坐标刻度值Next b

10、cEnd SubPrivate Sub ZuoDian(x() As Double, y() As Double)ReDim xpos(I) As DoubleReDim ypos(I) As DoubleFor I = 0 To Nxpos(I) = X0pos + (x(I) - Xmin) * xstepypos(I) = Y0pos + (y(I) - Ymin) * ystepIf y(I) = Ymax Then DrawWidth = 4 PSet (xpos(I), ypos(I), vbRedElseEnd If Next I DrawWidth = 1End SubPriv

11、ate Sub HuaQuXian(xiaoA() As Double)ReDim xpos(I) As DoubleReDim ypos(I) As DoubleDim Ysum As Double, Ii As DoubleFor Ii = Xmin To Xmax Step 1 / (Xmax - Xmin) Ysum = 0 For j = 1 To M Ysum = Ysum + xiaoA(j) * Ii (j - 1) Next j xpos(I) = X0pos + (Ii - Xmin) * xstep ypos(I) = Y0pos + (Ysum - Ymin) * ys

12、tepDrawWidth = 2If Ii = Xmin Then xpos(0) = X0pos + (Ii - Xmin) * xstep ypos(0) = Y0pos + (Ysum - Ymin) * ystepPSet (xpos(0), ypos(0)ElseEnd IfIf Ysum = Ymax ThenDrawWidth = 2Line -(xpos(I), ypos(I), vbBlueElseEnd IfNext IiDrawWidth = 1 End SubPrivate Sub JieFangCheng(A() As Double, B() As Double, x

13、() As Double)Dim nn As Doublenn = UBound(B)Dim TempA As Double, L As Double, K As Double, Kk As DoubleDim Ii As Double, ChuShu As Double, Sum As DoubleFor I = 1 To nn L = 0: Kk = 0 For j = I To nn If A(j, I) = 0 Then L = L + 1 Next j For j = I To nn - L If A(j, I) = 0 Then Kk = Kk + 1 For K = I To n

14、n TempA = A(j, K) A(j, K) = A(nn - Kk + 1, K) A(nn - Kk + 1, K) = TempA Next K TempA = B(j): B(j) = B(nn - Kk + 1): B(nn - Kk + 1) = TempA End If Next j For Ii = I To nn - L ChuShu = A(Ii, I) For j = I To nn A(Ii, j) = A(Ii, j) / ChuShu Next j B(Ii) = B(Ii) / ChuShu Next Ii For Ii = I + 1 To nn - L

15、For j = I To nn A(Ii, j) = A(Ii, j) - A(I, j) Next j B(Ii) = B(Ii) - B(I) Next IiNext IFor I = 1 To nn For j = 1 To I - 1 A(I, j) = 0 Next jNext I x(nn) = B(nn) / A(nn, nn)For I = nn - 1 To 1 Step -1 Sum = 0 For j = I + 1 To nn Sum = Sum + A(I, j) * x(j) Next j x(I) = (B(I) - Sum) / A(I, I)Next IEnd

16、 SubPrivate Sub Command1_Click()ClsXmin = 0 InputBox(请输入x坐标下限值, x坐标下限值, 0)Ymin = 0 InputBox(请输入y坐标下限值, y坐标下限值, 0)Xmax = 10 InputBox(请输入x坐标上限值, x坐标上限值度, 10)Ymax = 10 InputBox(请输入y坐标上限值, y坐标上限值度, 10)N = 20For I = 0 To N ReDim Preserve x(I) ReDim Preserve y(I) Next ICall HuaZuoBiao(x, y)End SubPrivate

17、Sub Command2_Click()For I = 0 To N x(I) = Xmin + I * (Xmax - Xmin) / N InputBox(请输入X坐标测量值, X坐标值, 0) y(I) = Sin(x(I) + 5 InputBox(请输入Y坐标测量值, Y坐标值, 0) Next ICall ZuoDian(x, y)End SubPrivate Sub Command3_Click()M = 20 InputBox(请输入拟合曲线次数M, 拟合曲线, 3)Erase B: Erase xiaoA: Erase A 必不可少*ReDim B(M): ReDim xia

18、oA(1 To M)形成方程组的各元素A(1, 1) = NFor I = 1 To N B(1) = B(1) + y(I)Next IFor j = 2 To M For I = 1 To N A(1, j) = A(1, j) + x(I) (j - 1) Next INext jFor I = 2 To M For j = 1 To M For Xh = 1 To N A(I, j) = A(I, j) + x(Xh) (I + j - 2) If j = 1 Then B(I) = B(I) + x(Xh) (I - 1) * y(Xh) End If Next Xh Next jNext ICall JieFangCheng(A, B, xiaoA)ForeColor = vbBlackPSet (0, 0)For I = 1 To M Print Tab(6); a; I - 1; Tab(12); =; xiaoA(I);Next IDim Str As String: Str = y=For I = 1 To M 写方程 If I M Then Str = Str & xiaoA(I) & *x & I - 1 & + Else Str = Str & xiaoA(I) & *x & I - 1 End IfNext IPrint vbCrLf; 曲线方程: