VB写的最小二乘法曲线拟合
《VB写的最小二乘法曲线拟合》由会员分享,可在线阅读,更多相关《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, ym
2、axpos 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 = Heigh
3、t * 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
4、(X0pos, Height * 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)-(Cur
5、rentX - 200, CurrentY + 50)CurrentX = X0pos - 500CurrentY = Height * 0.1 Print 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 绝对坐标处C
6、urrentY = Y0pos + 400 取当前 Y 轴上的相对坐标值Print f=f(x) 在 Y 轴左边 500 绝对坐标处对应显示 Y 轴相对坐标刻度值xl = Xmax - Xmin yl = Ymax - YminIf xl 0.01 Then xbc = 0.001ElseIf xl = 0.1 Then xbc = 0.01ElseIf xl = 2 Thenxbc = 0.1ElseIf xl = 20 Then xbc = 1ElseIf xl = 120 Then xbc = 10ElseIf xl = 1000 Then xbc = 100ElseIf xl = 10
7、000 Then xbc = 1000Elsexbc = 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 = 1ElseIf yl = 120 Thenybc = 10ElseIf yl = 1000 Thenybc = 100ElseIf yl = 10000 Then ybc = 1000Elseybc = 10000End IfFor bc = Xmin To Xmax Step xbcIf bc
8、 = Xmax Then x(j) = bc X 轴上的相对坐标值xpos(j) = X0pos + (x(j) - Xmin) * xstepLine (xpos(j), Y0pos)-(xpos(j), ymaxpos), vbRed 画垂直于 X 轴的刻度线,只画了ElseEnd IfFont.Size = 10 指定X轴,Y轴坐标刻度值的字体大小CurrentX = xpos(j) - 200 取当前X轴上的相对坐标值CurrentY = Y0pos + 100 此为X轴下方100绝对坐标处Print x(j)在X轴下方100绝对坐标处对应显示 X轴相对坐标刻度值Next bcFor
9、bc = Ymin To Ymax Step ybcIf bc = Ymax Theny(j) = bc X 轴上的相对坐标值ypos(j) = Y0pos + (y(j) - Ymin) * ystepLine (X0pos, ypos(j)-(xmaxpos, ypos(j), vbRed 画垂直于 X 轴的刻度线,只画了ElseEnd IfFont.Size = 10 指定X轴,Y轴坐标刻度值的字体大小CurrentX = X0pos - 500 取当前 X轴上的相对坐标值100 个绝对尺寸100 个绝对尺寸CurrentY = ypos(j) - 100 此为X轴下方100绝对坐标处P
10、rint y(j)在X轴下方100绝对坐标处对应显示X轴相对坐标刻度值Next bcEnd 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 ThenDrawWidth = 4PSet (xpos(I), ypos(I), vbRedEls
11、eEnd IfNext IDrawWidth = 1End SubPrivate 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 = 0For j = 1 To MYsum = Ysum + xiaoA(j) * Ii A (j - 1)Next jxpos(I) = X0pos + (Ii - Xmin) * xstepypo
12、s(I) = Y0pos + (Ysum - Ymin) * ystep DrawWidth = 2If Ii = Xmin Thenxpos(0) = X0pos + (Ii - Xmin) * xstepypos(0) = Y0pos + (Ysum - Ymin) * ystep PSet (xpos(0), ypos(0)ElseEnd IfIf Ysum = Ymax ThenDrawWidth = 2Line -(xpos(I), ypos(I), vbBlueElseEnd IfNext IiDrawWidth = 1End SubPrivate Sub JieFangCheng
13、(A() As Double, B() As Double, x() As Double) Dim nn As Double nn = 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 nnL = 0: Kk = 0For j = I To nnIf A(j, I) = 0 Then L = L + 1Next jFor j = I To nn - LIf A(j, I) = 0 The
14、nKk = Kk + 1For K = I To nnTempA = A(j, K)A(j, K) = A(nn - Kk + 1, K)A(nn - Kk + 1, K) = TempANext KTempA = B(j): B(j) = B(nn - Kk + 1): B(nn - Kk + 1) = TempA End IfNext jFor Ii = I To nn - L ChuShu = A(Ii, I)For j = I To nnA(Ii, j) = A(Ii, j) / ChuShuNext jB(Ii) = B(Ii) / ChuShuNext IiFor Ii = I +
15、 1 To nn - LFor j = I To nnA(Ii, j) = A(Ii, j) - A(I, j)Next jB(Ii) = B(Ii) - B(I)Next IiNext IFor I = 1 To nnFor j = 1 To I - 1A(I, j) = 0Next jNext I x(nn) = B(nn) / A(nn, nn)For I = nn - 1 To 1 Step -1Sum = 0For j = I + 1 To nnSum = Sum + A(I, j) * x(j)Next jx(I) = (B(I) - Sum) / A(I, I) Next IEn
16、d 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 NReDim Preserve x(I)ReDim Preserve y(I)Next ICall HuaZu
17、oBiao(x, y)End SubPrivate Sub Command2_Click()For I = 0 To Nx(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 x
18、iaoA: Erase A 必不可少 *ReDim B(M): ReDim xiaoA(1 To M)形成方程组的各元素A(1, 1) = NFor I = 1 To NB(1) = B(1) + y(I)Next IFor j = 2 To MFor I = 1 To NA(1, j) = A(1, j) + x(l)八(j - 1)Next INext jFor l = 2 To MFor j = 1 To MFor Xh = 1 To NA(l, j) = A(l, j) + x(Xh)人(I + j - 2)lf j = 1 ThenB(l) = B(l) + x(Xh) A (I -
19、 1) * y(Xh)End lfNext XhNext jNext lCall JieFangCheng(A, B, xiaoA)ForeColor = vbBlackPSet (0, 0)For I = 1 To MPrint Tab(6); a; I - 1; Tab(12); =; xiaoA(I);Next IDim Str As String: Str = y=For I = 1 To M写方程If I M ThenStr = Str & xiaoA(l) & 吩& I - 1 & +ElseStr = Str & xiaoA(I) & 吩& I - 1End IfNext IPr
20、int vbCrLf; 曲线方程 :; vbCrLf & StrCall HuaQuXian(xiaoA)End SubPrivate Sub Command4_Click()EndEnd SubPrivate Sub Form_Load()Width = Screen.Width * 1 取屏幕宽度的一半 Height = Screen.Height * 0.5 取屏幕高度的一半Height = Screen.Width * 1 取屏幕宽度的一半Left = (Screen.Width - Width) / 2 使窗体居屏幕中心 Top = (Screen.Height - Height) / 2 使窗体居屏幕中心End Sub
- 温馨提示:
1: 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
2: 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
3.本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
5. 装配图网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 嵌入式系统概论-以S3C2440核心为架构课件
- 地理事象的季节变化课件
- 地理中外著名旅游景观欣赏课件
- 地理中图版选修5第一章第二节主要自然灾害及其分布课件
- 地理中考复习-地图课件
- 北师大版历史八年级下册第17课《筑起钢铁长城》课件1
- 北师大版历史八下《祖国统一的历史大潮》课件5
- 北师大版历史八下《欣欣向荣的科教文体事业》3课件
- 北师大版历史八下《蓝色的地中海文明》课件
- 北师大版历史九年级下册第10课“冷战”与“热战”丁飞鹤T-课件
- 北师大版历史八下第17课《大河流域的文明曙光》课件
- 北师大版历史九上1718课课件
- 高中化学热力学复习10多重平衡与化学计算ppt课件
- 高中化学第1章化学反应与能量转化第3节化学能转化为电能电池ppt课件1鲁科版选修
- 高中化学第三节玻璃、陶瓷和水泥公开课课件