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 坐標(biāo)原點(diǎn)最左點(diǎn)Y0pos = Height

3、 * 0.75 坐標(biāo)原點(diǎn)最低點(diǎn)xmaxpos = Width * 0.85 坐標(biāo)最右點(diǎn)ymaxpos = Height * 0.15 坐標(biāo)最高點(diǎn)xstep = (xmaxpos - X0pos) / (Xmax - Xmin) 對(duì)應(yīng)X軸上單位長度代表的屏幕寬度值ystep = (ymaxpos - Y0pos) / (Ymax - Ymin) 對(duì)應(yīng)Y軸上單位長度代表的屏幕高度值在屏幕上畫直角坐標(biāo)系ForeColor = vbBlueLine (Width * 0.1, Y0pos)-(Width * 0.9, Y0pos) 畫X坐標(biāo)軸,從左10%，到右的90%處Line (X0pos, Hei

4、ght * 0.1)-(X0pos, Height * 0.9) 畫y坐標(biāo)軸,從上10%，到下的90%處Font.Size = 20 指定X軸，Y軸標(biāo)志的字體大小CurrentX = Width * 0.9CurrentY = Y0pos + 100Print X 在橫線上畫X軸標(biāo)志 在橫線上畫X軸箭頭標(biāo)志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軸標(biāo)志 在縱線上畫Y軸箭頭標(biāo)志CurrentX = X0posCurrentY = Height * 0.1Line (CurrentX - 50, CurrentY + 200)-(CurrentX, CurrentY)Line (CurrentX, CurrentY)-(CurrentX + 50, CurrentY + 200)CurrentX = X0pos + 200 此為Y軸左邊500絕對(duì)坐標(biāo)處CurrentY = Y0pos + 400 取當(dāng)前Y軸上的

6、相對(duì)坐標(biāo)值Print f=f(x) 在Y軸左邊500絕對(duì)坐標(biāo)處對(duì)應(yīng)顯示Y軸相對(duì)坐標(biāo)刻度值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軸上的相對(duì)坐標(biāo)值x

8、pos(j) = X0pos + (x(j) - Xmin) * xstepLine (xpos(j), Y0pos)-(xpos(j), ymaxpos), vbRed 畫垂直于X軸的刻度線，只畫了100個(gè)絕對(duì)尺寸ElseEnd IfFont.Size = 10 指定X軸，Y軸坐標(biāo)刻度值的字體大小CurrentX = xpos(j) - 200 取當(dāng)前X軸上的相對(duì)坐標(biāo)值CurrentY = Y0pos + 100 此為X軸下方100絕對(duì)坐標(biāo)處Print x(j) 在X軸下方100絕對(duì)坐標(biāo)處對(duì)應(yīng)顯示X軸相對(duì)坐標(biāo)刻度值Next bcFor bc = Ymin To Ymax Step ybcIf

9、 bc = Ymax Theny(j) = bc X軸上的相對(duì)坐標(biāo)值ypos(j) = Y0pos + (y(j) - Ymin) * ystepLine (X0pos, ypos(j)-(xmaxpos, ypos(j), vbRed 畫垂直于X軸的刻度線，只畫了100個(gè)絕對(duì)尺寸ElseEnd IfFont.Size = 10 指定X軸，Y軸坐標(biāo)刻度值的字體大小CurrentX = X0pos - 500 取當(dāng)前X軸上的相對(duì)坐標(biāo)值CurrentY = ypos(j) - 100 此為X軸下方100絕對(duì)坐標(biāo)處Print y(j) 在X軸下方100絕對(duì)坐標(biāo)處對(duì)應(yīng)顯示X軸相對(duì)坐標(biāo)刻度值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(請(qǐng)輸入x坐標(biāo)下限值, x坐標(biāo)下限值, 0)Ymin = 0 InputBox(請(qǐng)輸入y坐標(biāo)下限值, y坐標(biāo)下限值, 0)Xmax = 10 InputBox(請(qǐng)輸入x坐標(biāo)上限值, x坐標(biāo)上限值度, 10)Ymax = 10 InputBox(請(qǐng)輸入y坐標(biāo)上限值, y坐標(biāo)上限值度, 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(請(qǐng)輸入X坐標(biāo)測(cè)量值, X坐標(biāo)值, 0) y(I) = Sin(x(I) + 5 InputBox(請(qǐng)輸入Y坐標(biāo)測(cè)量值, Y坐標(biāo)值, 0) Next ICall ZuoDian(x, y)End SubPrivate Sub Command3_Click()M = 20 InputBox(請(qǐng)輸入擬合曲線次數(shù)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; 曲線方程: