lagrange_and_newton插值法vb实现.pdfVIP

  • 27
  • 0
  • 约2.88千字
  • 约 5页
  • 2016-03-12 发布于山西
  • 举报
lagrange_and_newton插值法vb实现

Lagrange and newton 插值 法 程序结构如下 窗体设计如下(一个空白窗体,大小下图中有) 程序代码如下 注意!!!!!!!!!!下面程序代码中深红色部 分为VB6.0 中自带的部分。而紫红色部分为 在VB6.0 中应写在一行中,但在本文中由于 纸张限制出现分行的部分,此部分在写入 VB6.0 时应该写在一行中,否则会出现错误 Function SS#(aaa#(), bbb#()) Dim ii, jj, kk, mm, nn, rr, uu, ll#, lll#, xk# nn = UBound(aaa): mm = UBound(bbb) ll = 0 For jj = 0 To mm xk = aaa(jj) If jj mm Then For kk = jj + 1 To nn aaa(kk - 1) = aaa(kk) Next kk uu = nn - 1 ReDim Preserve aaa(uu) Else uu = nn - 1 ReDim Preserve aaa(uu) End If lll = 1 For ii = 0 To uu lll = (xk - aaa(ii)) * lll Next ii ll = bbb(jj) / lll + ll ReDim Preserve aaa(0 To nn) For rr = nn - 1 To jj Step -1 aaa(rr + 1) = aaa(rr) Next rr aaa(jj) = xk Next jj SS = ll End Function Function S#(aa#(), bb#(), v#) Dim i, j, k, m, n, r, u, l#, ll#, g# Dim cs#(), aa1#(), bb1#() n = UBound(aa): m = UBound(bb) ReDim cs#(n) For i = 1 To n ReDim aa1#(i), bb1#(i) For j = 0 To i aa1(j) = aa(j) bb1(j) = bb(j) Next j g = SS#(aa1(), bb1()) cs(i) = g l = g * W(aa(), v, i) + l S = l + bb(0) Next i l = 0 For r = 1 To n l = cs(r) * W(aa(), v, r) + l Next r S = l + bb(0) End Function Function W#(pp#(), x#, n) Dim y, ww# ww = 1 For y = 0 To n - 1 ww = (x - pp(y)) * ww Next y W = ww End Function Function Lagrange#(x, aa#(), bb#()) Dim i, j, k, n, m, r, ll#, lll#, l#, xk#, u l = 0 n = UBound(aa): m = UBound(bb) For j = 0 To m ll = 1: lll = 1 xk = aa(j) If j m Then For k = j + 1 To n aa(k - 1) = aa(k) Next k u = n - 1 ReDim Preserve aa(u) Else u = n - 1 ReDim Preserve aa(u) End If For i = 0 To u ll = (x - aa(i)) * ll lll = (xk - aa(i)) * lll Next i l = bb(j) * ll / lll + l ReDim Preserve aa(n) For r = u To j Step -1 aa(r + 1) = aa(r) Next r aa(j) = xk Next j Lagrange = l End Function Private Sub tt() Dim q q = Val(InputBox(输入插值节点数,

文档评论(0)

1亿VIP精品文档

相关文档