用vb实现利用三次样条插值函数进行编程.doc

用vb实现利用三次样条插值函数进行编程 问题内容：要求输入节点数，节点值与端点二阶导数，能获得屏幕输出插值函数表达式网友 cz5360 于 提问最佳回答：vb三次样条插值函数绘图Dim X(1000) As Single, Y(1000) As SingleDim u1(0 To 80000) As Single, v1(0 To 80000) As SingleDim num As LongDim t As IntegerPrivate Declare Sub Sleep Lib kernel32 (ByVal dwMilliseconds As Long)Dim de As IntegerDim ToInit As BooleanDim DownX As Single, DownY As SingleSub Drawposi(Index As Integer) Me.Picture1.ForeColor = 0 Me.Picture1.Line (0, Y(Index)-(1024, Y(Index) Me.Picture1.Line (X(Index), 0)-(X(Index), 770)End SubFunction hypot(ByVal X As Single, ByVal Y As Single) hypot = Sqr(X 2 + Y 2)End FunctionSub MovePic(Index As Integer) Dim i As Integer X(Index) = Picture2(Index).Left + 4 Y(Index) = Picture2(Index).Top + 4 lblX.Caption = X: + CStr(CInt(X(Index) lblY.Caption = Y: + CStr(CInt(Y(Index) lblX.Refresh lblY.Refresh Me.Picture1.Cls Me.Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Me.Picture1.CurrentX = X(i) + 4 Me.Picture1.CurrentY = Y(i) + 4 Me.Picture1.Print i Next iEnd SubPrivate Sub Command1_Click()Dim i As Long Picture1.Scale (0, 0)-(640, 550) DrawWidth = 3 Picture1.Cls If Check1.Value Then Command2_Click X(0) = 1 Y(0) = 1 X(t - 1) = 638 Y(t - 1) = 548 Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B Picture1.Print i Next i Picture1.ForeColor = QBColor(12) DrawWidth = 1 tspLine t - 1, 2, 0, 0, 0, 0 Picture1.PSet (u1(0), v1(0) For i = 1 To num - 1 Picture1.Line -(u1(i), v1(i) For de = 1 To 12000: Next de Sleep 1 Next i Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B Picture1.Print i Next iEnd SubPrivate Sub Command2_Click()Dim i As Integer Randomize Timer ToInit = Not ToInit If ToInit Then Me.Command1.Enabled = False Me.Command2.Caption = 结束初始化 Me.Cls For i = 1 To t - 1 Load Me.Picture2(i) Next i For i = 0 To t - 1 Picture2(i).Left = X(i) - 4 Picture2(i).Top = Y(i) - 4 Picture2(i).Visible = True Next i Picture1.Cls Me.Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B Picture1.Print i Next i Else Me.Command1.Enabled = True Me.Command2.Caption = 开始初始化 For i = 1 To t - 1 Unload Me.Picture2(i) Next i Me.Picture2(0).Visible = False End If Exit Sub For i = 0 To t X(i) = Rnd(1) * 500 + Rnd(1) * 50 + 12 Y(i) = Rnd(1) * 400 + Rnd(1) * 100 + 12 X(i) = i * 20 + Rnd(1) * 10 + 12 Y(i) = i * 10 + Rnd(1) * 300 + 22 - Rnd(1) * 200 Next iEnd SubSub tspLine(ByVal n As Integer, ByVal ch As Integer, ByVal tx1 As Single, ByVal tx2 As Single, ByVal ty1 As Single, ByVal ty2 As Single)Dim a(1000) As Single, b(1000) As Single, c(1000) As Single, dX(1000) As Single, dY(1000) As SingleDim qx(1000) As Single, qy(1000) As SingleDim tt As Single, bx3 As Single, bx4 As Single, by3 As Single, by4 As SingleDim cx As Single, cy As Single, t(1000) As Single, px(1000) As Single, py(1000) As SingleDim u(3000) As Single, v(3000) As Single, i As Integernum = 0For i = 1 To n t(i) = hypot(X(i) - X(i - 1), Y(i) - Y(i - 1)Next iSelect Case ch Case 0 抛物条件 u(0) = (X(1) - X(0) / t(1): u(1) = (X(2) - X(1) / t(2) u(2) = (u(1) - u(0) / (t(2) + t(1) tx1 = u(0) - u(2) * t(1) u(0) = (Y(1) - Y(0) / t(1): u(1) = (Y(2) - Y(1) / t(2) u(2) = (u(1) - u(0) / (t(2) + t(1) ty1 = u(0) - u(2) * t(1) u(0) = (X(n) - X(n - 1) / t(n): u(1) = (X(n - 1) - X(n - 2) / t(n - 1) u(2) = (u(0) - u(1) / (t(n) + t(n - 1) tx2 = u(0) + u(2) * t(n) u(0) = (Y(n) - Y(n - 1) / t(n): u(1) = (Y(n - 1) - Y(n - 2) / t(n - 1) u(2) = (u(0) - u(1) / (t(n) + t(n - 1) ty2 = u(0) + u(2) * t(n) Case 1 夹持条件 a(0) = 1: c(0) = 0: dX(0) = tx1: dY(0) = ty1 a(n) = 1: b(n) = 0: dX(n) = tx2: dY(n) = ty2 Case 2 自由条件 a(0) = 2: c(0) = 1 dX(0) = 3 * (X(1) - X(0) / t(1): dY(0) = 3 * (Y(1) - Y(0) / t(1) a(n) = 2: b(n) = 1 dX(n) = 3 * (X(n) - X(n - 1) / t(n): dY(n) = 3 * (Y(n) - Y(n - 1) / t(n) Case 3 循环条件 a(0) = 2: c(0) = 1 dX(0) = 3 * (X(1) - X(0) / t(1) - (t(1) * (X(2) - X(1) / t(2) - X(1) + X(0) / (t(1) + t(2) dY(0) = 3 * (Y(1) - Y(0) / t(1) - (t(1) * (Y(2) - Y(1) / t(2) - Y(1) + Y(0) / (t(1) + t(2) a(n) = 2: b(n) = 1 dX(n) = 3 * (X(n) - X(n - 1) / t(n) dX(n) = dX(n) + (X(n) - X(n - 1) - t(n) * (X(n - 1) - X(n - 2) / t(n - 1) / (t(n) + t(n - 1) dY(n) = 3 * (Y(n) - Y(n - 1) / t(n) dY(n) = dY(n) + (Y(n) - Y(n - 1) - t(n) * (Y(n - 1) - Y(n - 2) / t(n - 1) / (t(n) + t(n - 1)End Select计算方程组系数阵和常数阵For i = 1 To n - 1 a(i) = 2 * (t(i) + t(i + 1): b(i) = t(i + 1): c(i) = t(i) dX(i) = 3 * (t(i) * (X(i + 1) - X(i) / t(i + 1) + t(i + 1) * (X(i) - X(i - 1) / t(i) dY(i) = 3 * (t(i) * (Y(i + 1) - Y(i) / t(i + 1) + t(i + 1) * (Y(i) - Y(i - 1) / t(i)Next i采用追赶法解方程组c(0) = c(0) / a(0)For i = 1 To n - 1 a(i) = a(i) - b(i) * c(i - 1): c(i) = c(i) / a(i)Next ia(n) = a(n) - b(n) * c(i - 1)qx(0) = dX(0) / a(0): qy(0) = dY(0) / a(0)For i = 1 To n qx(i) = (dX(i) - b(i) * qx(i - 1) / a(i) qy(i) = (dY(i) - b(i) * qy(i - 1) / a(i)Next ipx(n) = qx(n): py(n) = qy(n)For i = n - 1 To 0 Step -1 px(i) = qx(i) - c(i) * px(i + 1) py(i) = qy(i) - c(i) * py(i + 1)Next i计算曲线上点的坐标For i = 0 To n - 1 bx3 = (3 * (X(i + 1) - X(i) / t(i + 1) - 2 * px(i) - px(i + 1) / t(i + 1) bx4 = (2 * (X(i) - X(i + 1) / t(i + 1) + px(i) + px(i + 1) / t(i + 1) / t(i + 1) by3 = (3 * (Y(i + 1) - Y(i) / t(i + 1) - 2 * py(i) - py(i + 1) / t(i + 1) by4 = (2 * (Y(i) - Y(i + 1) / t(i + 1) + py(i) + py(i + 1) / t(i + 1) / t(i + 1) tt = 0 While (tt = t(i + 1) cx = X(i) + (px(i) + (bx3 + bx4 * tt) * tt) * tt cy = Y(i) + (py(i) + (by3 + by4 * tt) * tt) * tt u1(num) = cx: v1(num) = cy: num = num + 1: tt = tt + 0.5 Wend u1(num) = X(i + 1): v1(num) = Y(i + 1): num = num + 1Next iEnd SubPrivate Sub Form_Load()Dim i As Integert = 30ToInit = False Picture1.Scale (0, 0)-(640, 550) Randomize Timer Me.Command2.Caption = 开始初始化 For i = 0 To t X(i) = Rnd(1) * 500 + Rnd(1) * 50 + 12 Y(i) = Rnd(1) * 400 + Rnd(1) * 100 + 12 Next i For i = 0 To t X(i) = i * 30 + 20 Y(i) = i * 20 + 20 Next iMe.Picture1.Picture = LoadPicture(c:my documentsMenuBack.bmp)Me.Picture1.BackColor = QBColor(0)End SubPrivate Sub Form_Resize() On Error Resume Next Me.Picture1.Height = Me.ScaleHeight - 40End SubPrivate Sub Form_Unload(Cancel As Integer) EndEnd SubPrivate Sub Picture2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next If Button = 1 Then DownX = X DownY = Y Picture2(Index).ZOrder 0 Picture2(Index - 1).BackColor = QBColor(12) Picture2(Index + 1).BackColor = QBColor(12) lblX.Caption = X: + CStr(CInt(Picture2(Index).Left + 4) lblY.Caption = Y: + CStr(CInt(Picture2(Index).Top + 4) lblX.Refresh lblY.Refresh MovePic Index Drawposi Index End IfEnd SubPrivate Sub Picture2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Picture2(Index).Left = Picture2(Index).Left - DownX + X Picture2(Index).Top = Picture2(Index).Top - DownY + Y MovePic Index Command1_Click Drawposi Index End IfEnd SubPrivate Sub Picture2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next If Button = 1 Then DownX = X DownY = Y Picture2(Index - 1).BackColor = QBColor(15) Picture2(Index + 1).BackColor = QBColor(15) MovePic Index lblX.Caption = X: lblY.Caption = Y: lblX.Refresh lblY.Refresh Command1_Click End IfEnd Subvb三次样条插值函数绘图Dim X(1000) As Single, Y(1000) As SingleDim u1(0 To 80000) As Single, v1(0 To 80000) As SingleDim num As LongDim t As IntegerPrivate Declare Sub Sleep Lib kernel32 (ByVal dwMilliseconds As Long)Dim de As IntegerDim ToInit As BooleanDim DownX As Single, DownY As SingleSub Drawposi(Index As Integer) Me.Picture1.ForeColor = 0 Me.Picture1.Line (0, Y(Index)-(1024, Y(Index) Me.Picture1.Line (X(Index), 0)-(X(Index), 770)End SubFunction hypot(ByVal X As Single, ByVal Y As Single) hypot = Sqr(X 2 + Y 2)End FunctionSub MovePic(Index As Integer) Dim i As Integer X(Index) = Picture2(Index).Left + 4 Y(Index) = Picture2(Index).Top + 4 lblX.Caption = X: + CStr(CInt(X(Index) lblY.Caption = Y: + CStr(CInt(Y(Index) lblX.Refresh lblY.Refresh Me.Picture1.Cls Me.Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Me.Picture1.CurrentX = X(i) + 4 Me.Picture1.CurrentY = Y(i) + 4 Me.Picture1.Print i Next iEnd SubPrivate Sub Command1_Click()Dim i As Long Picture1.Scale (0, 0)-(640, 550) DrawWidth = 3 Picture1.Cls If Check1.Value Then Command2_Click X(0) = 1 Y(0) = 1 X(t - 1) = 638 Y(t - 1) = 548 Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B Picture1.Print i Next i Picture1.ForeColor = QBColor(12) DrawWidth = 1 tspLine t - 1, 2, 0, 0, 0, 0 Picture1.PSet (u1(0), v1(0) For i = 1 To num - 1 Picture1.Line -(u1(i), v1(i) For de = 1 To 12000: Next de Sleep 1 Next i Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B Picture1.Print i Next iEnd SubPrivate Sub Command2_Click()Dim i As Integer Randomize Timer ToInit = Not ToInit If ToInit Then Me.Command1.Enabled = False Me.Command2.Caption = 结束初始化 Me.Cls For i = 1 To t - 1 Load Me.Picture2(i) Next i For i = 0 To t - 1 Picture2(i).Left = X(i) - 4 Picture2(i).Top = Y(i) - 4 Picture2(i).Visible = True Next i Picture1.Cls Me.Picture1.ForeColor = QBColor(10) For i = 0 To t - 1 Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B Picture1.Print i Next i Else Me.Command1.Enabled = True Me.Command2.Caption = 开始初始化 For i = 1 To t - 1 Unload Me.Picture2(i) Next i Me.Picture2(0).Visible = False End If Exit Sub For i = 0 To t X(i) = Rnd(1) * 500 + Rnd(1) * 50 + 12 Y(i) = Rnd(1) * 400 + Rnd(1) * 100 + 12 X(i) = i * 20 + Rnd(1) * 10 + 12 Y(i) = i * 10 + Rnd(1) * 300 + 22 - Rnd(1) * 200 Next iEnd SubSub tspLine(ByVal n As Integer, ByVal ch As Integer, ByVal tx1 As Single, ByVal tx2 As Single, ByVal ty1 As Single, ByVal ty2 As Single)Dim a(1000) As Single, b(1000) As Single, c(1000) As Single, dX(1000) As Single, dY(1000) As SingleDim qx(1000) As Single, qy(1000) As SingleDim tt As Single, bx3 As Single, bx4 As Single, by3 As Single, by4 As SingleDim cx As Single, cy As Single, t(1000) As Single, px(1000) As Single, py(1000) As SingleDim u(3000) As Single, v(3000) As Single, i As Integernum = 0For i = 1 To n t(i) = hypot(X(i) - X(i - 1), Y(i) - Y(i - 1)Next iSelect Case ch Case 0 抛物条件 u(0) = (X(1) - X(0) / t(1): u(1) = (X(2) - X(1) / t(2) u(2) = (u(1) - u(0) / (t(2) + t(1) tx1 = u(0) - u(2) * t(1) u(0) = (Y(1) - Y(0) / t(1): u(1) = (Y(2) - Y(1) / t(2) u(2) = (u(1) - u(0) / (t(2) + t(1) ty1 = u(0) - u(2) * t(1) u(0) = (X(n) - X(n - 1) / t(n): u(1) = (X(n - 1) - X(n - 2) / t(n - 1) u(2) = (u(0) - u(1) / (t(n) + t(n - 1) tx2 = u(0) + u(2) * t(n) u(0) = (Y(n) - Y(n - 1) / t(n): u(1) = (Y(n - 1) - Y(n - 2) / t(n - 1) u(2) = (u(0) - u(1) / (t(n) + t(n - 1) ty2 = u(0) + u(2) * t(n) Case 1 夹持条件 a(0) = 1: c(0) = 0: dX(0) = tx1: dY(0) = ty1 a(n) = 1: b(n) = 0: dX(n) = tx2: dY(n) = ty2 Case 2 自由条件 a(0) = 2: c(0) = 1 dX(0) = 3 * (X(1) - X(0) / t(1): dY(0) = 3 * (Y(1) - Y(0) / t(1) a(n) = 2: b(n) = 1 dX(n) = 3 * (X(n) - X(n - 1) / t(n): dY(n) = 3 * (Y(n) - Y(n - 1) / t(n) Case 3 循环条件 a(0) = 2: c(0) = 1 dX(0) = 3 * (X(1) - X(0) / t(1) - (t(1) * (X(2) - X(1) / t(2) - X(1) + X(0) / (t(1) + t(2) dY(0) = 3 * (Y(1) - Y(0) / t(1) - (t(1) * (Y(2) - Y(1) / t(2) - Y(1) + Y(0) / (t(1) + t(2) a(n) = 2: b(n) = 1 dX(n) = 3 * (X(n) - X(n - 1) / t(n) dX(n) = dX(n) + (X(n) - X(n - 1) - t(n) * (X(n - 1) - X(n - 2) / t(n - 1) / (t(n) + t(n - 1) dY(n) = 3 * (Y(n) - Y(n - 1) / t(n) dY(n) = dY(n) + (Y(n) - Y(n - 1) - t(n) * (Y(n - 1) - Y(n - 2) / t(n - 1) / (t(n) + t(n - 1)End Select计算方程组系数阵和常数阵For i = 1 To n - 1 a(i) = 2 * (t(i) + t(i + 1): b(i) = t(i + 1): c(i) = t(i) dX(i) = 3 * (t(i) * (X(i + 1) - X(i) / t(i + 1) + t(i + 1) * (X(i) - X(i - 1) / t(i) dY(i) = 3 * (t(i) * (Y(i + 1) - Y(i) / t(i + 1) + t(i + 1) * (Y(i) - Y(i - 1) / t(i)Next i采用追赶法解方程组c(0) = c(0) / a(0)For i = 1 To n - 1 a(i) = a(i) - b(i) * c(i - 1): c(i) = c(i) / a(i)Next ia(n) = a(n) - b(n) * c(i - 1)qx(0) = dX(0) / a(0): qy(0) = dY(0) / a(0)For i = 1 To n qx(i) = (dX(i) - b(i) * qx(i - 1) / a(i) qy(i) = (dY(i) - b(i) * qy(i - 1) / a(i)Next ipx(n) = qx(n): py(n) = qy(n)For i = n - 1 To 0 Step -1 px(i) = qx(i) - c(i) * px(i + 1) py(i) = qy(i) - c(i) * py(i + 1)Next i计算曲线上点的坐标For i = 0 To n - 1 bx3 = (3 * (X(i + 1) - X(i) / t(i + 1) - 2 * px(i) - px(i + 1) / t(i + 1) bx4 = (2 * (X(i) - X(i + 1) / t(i + 1) + px(i) + px(i + 1) / t(i + 1) / t(i + 1) by3 = (3 * (Y(i + 1) - Y(i) / t(i + 1) - 2 * py(i) - py(i + 1) / t(i + 1) by4 = (2 * (Y(i) - Y(i + 1) / t(i + 1) + py(i) + py(i + 1) / t(i + 1) / t(i + 1) tt = 0 While (tt = t(i + 1) cx = X(i) + (px(i) + (bx3 + bx4 * tt) * tt) * tt cy = Y(i) + (py(i) + (by3 + by4 * tt) * tt) * tt u1(num) = cx: v1(num) = cy: num = num + 1: tt = tt + 0.5 Wend u1(num) = X(i + 1): v1(num) = Y(i + 1): num = num + 1Next iEnd SubPrivate Sub Form_Load()Dim i As Integert = 30ToInit = False Picture1.Scale (0, 0)-(640, 550) Randomize Timer Me.Command2.Caption = 开始初始化 For i = 0 To t X(i) = Rnd(1) * 500 + Rnd(1) * 50 + 12 Y(i) = Rnd(1) * 400 + Rnd(1) * 100 + 12 Next i For i = 0 To t X(i) = i * 30 + 20 Y(i) = i * 20 + 20 Next iMe.Picture1.Picture = LoadPicture(c:my documentsMenuBack.bmp)Me.Picture1.BackColor = QBColor(0)End SubPrivate Sub Form_Resize() On Error Resume Next Me.Picture1.Height = Me.ScaleHeight - 40End SubPrivate Sub Form_Unload(Cancel As Integer) EndEnd SubPrivate Sub Picture2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next If Button = 1 Then DownX = X DownY = Y Picture2(Index).ZOrder 0 Picture2(Index - 1).BackColor = QBColor(12) Picture2(Index + 1).BackColor = QBColor(12) lblX.Caption = X: + CStr(CInt(Picture2(Index).Left + 4) lblY.Caption = Y: + CStr(CInt(Picture2(Index).Top + 4) lblX.Refresh lblY.Refresh MovePic Index Drawposi Index End IfEnd SubPrivate Sub Picture2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Picture2(Index).Left = Picture2(Index).Left - DownX + X Picture2(Index).Top = Picture2(Index).Top - DownY + Y MovePic Index Command1_Click Drawposi Index End IfEnd SubPrivate Sub Picture2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next If Button = 1 Then DownX = X DownY = Y Picture2(Index - 1).BackColor = QBColor(15) Picture2(Index + 1).BackColor = QBColor(15) MovePic Index lblX.Caption = X: lblY.Caption = Y: lblX.Refresh lblY.Refresh Command1_Click End IfEnd Sub三次样条插值函数高次插值函数的计算量大,有剧烈振荡,且数值稳定性差；在分段插值中，分段线性插值在分段点上仅连续而不可导，分段三次埃尔米特插值有连续的一阶导数，如此光滑程度常不能满足物理问题的需要，样条函数可以同时解决这两个问题,使插值函数既是低阶分段函数,又是光滑的函数，并且只需在区间端点提供某些导数信息。5.6.1三次样条函数定义 设在区间a,b上取 n+1 个节点a= =b函数y=f(x)在各个节点处的函数值为 =f( )(i=0，1，n)，若S(x)满足：(1) S( )= ，i=0，1，n ；(2) 在区间a,b上，S(x)具有连续的二阶导数；(3)