VB寫的最小二乘法曲線擬合(共8頁(yè))

1、精選優(yōu)質(zhì)文檔-傾情為你奉上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 xmax

2、pos As Double, ymaxpos 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 

3、9;坐標(biāo)原點(diǎn)最左點(diǎn)Y0pos = Height * 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軸上單位長(zhǎng)度代表的屏幕寬度值ystep = (ymaxpos - Y0pos) / (Ymax - Ymin) '對(duì)應(yīng)Y軸上單位長(zhǎng)度代表的屏幕高度值'在屏幕上畫直角坐標(biāo)系ForeColor = vbBlueLine (Width * 0.1, Y0pos)-(Wi

4、dth * 0.9, Y0pos) '畫X坐標(biāo)軸,從左10%，到右的90%處Line (X0pos, Height * 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 - 2

5、00, CurrentY - 50)-(CurrentX, CurrentY)Line (CurrentX, CurrentY)-(CurrentX - 200, CurrentY + 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 (Curren

6、tX, CurrentY)-(CurrentX + 50, CurrentY + 200)CurrentX = X0pos + 200 '此為Y軸左邊500絕對(duì)坐標(biāo)處CurrentY = Y0pos + 400 '取當(dāng)前Y軸上的相對(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

7、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 = 10000End 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 =

8、 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)值xpos(j) = X0pos + (x(j) - Xmin) * xstepLine (xpos(j), Y0pos)-(xpos(j), ymaxpos), vbRed ' 畫垂

9、直于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 bc <= Ymax Theny(j) = bc 'X軸上的相對(duì)坐標(biāo)值ypos(j) = Y0pos + (y(j) -

10、 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 bcEnd SubPrivate Sub ZuoDian(x() A

11、s 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 SubPrivate Sub HuaQuXian(xiaoA() As

12、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) * ystepDrawWidth = 2If Ii = Xmin

13、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() As Double)Dim nn As Do

14、ublenn = 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 nn TempA = A(j, K) A(j, K)

15、 = 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 For j = I To nn A(Ii, j)

16、= 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 SubPrivate Sub Command1_

17、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

18、I = 0 To N ReDim Preserve x(I) ReDim Preserve y(I) Next ICall HuaZuoBiao(x, y)End SubPrivate 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è)量值", &q

19、uot;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 xiaoA(1 To M)'形成方程組的各元素A(1, 1) = NFor I = 1 To N B(1) = B(1) + y(I)Next IFor

20、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