为了正常的体验网站,请在浏览器设置里面开启Javascript功能!

东北石油大学计算方法上机实验答案

2013-05-04 8页 doc 90KB 29阅读

用户头像

is_345307

暂无简介

举报
东北石油大学计算方法上机实验答案实验一 1. Private Function f(x!) f=x^3-2*x^2-4*x-7 End Function Private Sub form_click() Dim a!, b!, x!, c! a = 3: b = 4 Do While Abs(b - a) > 0.00001 c = (a + b) / 2 If f(c) = 0 Then Exit Do Else If f(a) * f(c) 0.00001 y = (a + b) / 2 If f(y...
东北石油大学计算方法上机实验答案
实验一 1. Private Function f(x!) f=x^3-2*x^2-4*x-7 End Function Private Sub form_click() Dim a!, b!, x!, c! a = 3: b = 4 Do While Abs(b - a) > 0.00001 c = (a + b) / 2 If f(c) = 0 Then Exit Do Else If f(a) * f(c) < 0 Then b = c Else a = c End If End If Loop Print c End Sub 1.(对1进行修改后,要求输入隔根区间的上下界就能求出根的程序) Private Function f(x!) f = x ^ 3 - 2 * x ^ 2 - 4 * x - 7 End Function Private Function g(a!, b!) Dim y! Do While Abs(b - a) > 0.00001 y = (a + b) / 2 If f(y) = 0 Then Exit Do Else If f(a) * f(y) < 0 Then b = y Else a = y End If End If Loop g = y End Function Private Sub form_click() Dim a!, b! a = InputBox("输入隔根区间上界") b = InputBox("输入隔根区间下界") c = g(a, b) Print c End Sub 2. Private Function f(x!) f = x ^ 4 - 5 * x ^ 2 + x + 2 End Function Private Sub form_click() Dim a!, b!, c!, h!, x!, i%, j%, p(0 To 4) As Single, q(0 To 4) As Single a = -6: b = 6: h = 0.3 x = a i = 0 For j = 0 To 100 If f(x) * f(x + h) <= 0 Then p(i) = x q(i) = x + h Print "["; p(i); ","; q(i); "]" i = i + 1 End If j = j + 1 x = x + h Next Print "实根分别为:" For i = 0 To 3 a = p(i) b = q(i) Do While Abs(b - a) > 0.00001 c = (a + b) / 2 If f(c) = 0 Then Exit Do Else If f(a) * f(c) < 0 Then b = c Else a = c End If End If Loop Print "root="; c Next End Sub (h 取值 使得划分的隔根区间避开根所在得区间上下界) 3. Private Sub form_click() Dim a(0 To 20) As Single, y As Single, x As Single Dim i As Integer, n As Integer n = InputBox("输入多项式的次数") For i = 0 To n a(i) = InputBox("输入a(" & Str(i) & ")") Next i x = InputBox("输入x") y = a(n) For i = 1 To n y = y * x + a(n - i) Next i Print y End Sub 实验二 1.(1) Private Sub form_click() Dim x0 As Single, x1 As Single Dim M As Integer x1 = 2: M = 5: k = 1 Do x0 = x1 x1 = x0 - (x0 ^ 3 - x0 ^ 2 - 2 * x0 - 3) / (3 * x0 ^ 2 - 2 * x0 - 2) k = k + 1 Loop While k < M And Abs(x1 - x0) > 0.00001 Print x1 End Sub (2) Private Sub form_click() Dim x0 As Single, x1 As Single Dim M As Integer x1 = 1: M = 6: k = 1 Do x0 = x1 x1 = x0 - (x0 - Sin(x0) - 0.5) / (1 - Cos(x0)) k = k + 1 Loop While k < M And Abs(x1 - x0) > 0.00001 Print x1 End Sub 2 Private Sub form_click() Dim x0 As Single, x1 As Single Dim a As Integer a = InputBox("输入a") If a = 0 Then Print "a的立方根=0" End End If x1 = a Do x0 = x1 x1 = x0 - (x0 ^ 3 - a) / (3 * x0 ^ 2) Loop While Abs(x1 - x0) > 0.000005 Print "a的立方根为:"; x1 End Sub 3. Private Sub form_click() Dim x0 As Single, x1 As Single, x2 As Single Dim M As Integer x1 = 0: x2 = 1: M = 6: k = 1 Do x0 = x1 x1 = x2 x2 = x1 - (f(x1) * (x1 - x0) / (f(x1) - f(x0))) k = k + 1 Loop While k < M And Abs(x1 - x0) > 0.0001 Print x1 End Sub Private Function f(x!) f = x + Sin(x) - 1 End Function 4. Private Sub form_click() Dim x#, x1# x1 = 1 Do x = x1 x1 = x - (x - Exp(-x)) / (1 + Exp(-x)) Loop While Abs(x1 - x) >= 10 ^ (-5) Print "a的立方根为:"; x1 End Sub 实验三 1.按列选主元德高斯消去法解线性方程组的通用程序 Option Base 1 Private Sub Form_Click() Dim a(1 To 3, 1 To 4) As Single, t#, i!, j!, k!, r!, l#, x(1 To 3) As Single For i = 1 To 3 For j = 1 To 4 a(i, j) = InputBox("输入一个数") Print a(i, j); Next j Print Next i For k = 1 To 2 r = k For i = k + 1 To 3 If Abs(a(i, k)) > Abs(a(r, k)) Then r = i Next i If r <> k Then For i = 1 To 4 t = a(k, i) a(k, i) = a(r, i) a(r, i) = t Next i End If For i = k + 1 To 3 l = a(i, k) / a(k, k) For j = k + 1 To 4 a(i, j) = a(i, j) - l * a(k, j) Next j Next i Next k For k = 3 To 1 Step -1 s = 0 For j = k + 1 To 3 s = s + a(k, j) * x(j) Next j x(k) = (a(k, 4) - s) / a(k, k) Next k For i = 1 To 3 Print x(i), Next i End Sub 3.用LU分解法解线性方程组 Private Sub form_click() Const n = 4 Dim a(1 To n, 1 To n) As Single, l(1 To n, 1 To n) As Single, u(1 To n, 1 To n) As Single Dim x(1 To n) As Single, y(1 To n) As Single, b(1 To n) As Single, s#, i!, j!, k!, r! For i = 1 To n For j = 1 To n a(i, j) = InputBox("输入a数组") Print a(i, j), Next j Print Next i For i = 1 To n b(i) = InputBox("输入b数组") Print b(i), Next i Print For k = 1 To n For j = k To n s = 0 For r = 1 To k - 1 s = s + l(k, r) * u(r, j) Next r u(k, j) = a(k, j) - s Next j For i = k + 1 To n s = 0 For r = 1 To k - 1 s = s + l(i, r) * u(r, k) Next r l(i, k) = (a(i, k) - s) / u(k, k) Next i Next k For i = 1 To n s = 0 For k = 1 To i - 1 s = s + l(i, k) * y(k) Next k y(i) = b(i) - s Next i For i = n To 1 Step -1 s = 0 For k = i + 1 To n s = s + (u(i, k) * x(k)) Next k x(i) = (y(i) - s) / u(i, i) Next i For i = 1 To n Print x(i) Next i End Sub 实验四 5. 雅克比迭代 Option Base 1 Function cha(x!(), y!()) As Single Dim z As Single, i As Single, k As Integer n = 3 z = Abs(x(1) - y(1)) For i = 2 To n If z < Abs(x(i) - y(i)) Then z = Abs(x(i) - y(i)) Next i cha = z End Function Private Sub form_click() Dim a1, x(3) As Single, y(3) As Single Dim t As Single, s As Single, a(3, 3) As Single Dim i As Integer, j As Integer, k As Integer, n As Integer n = 3 a1 = Array(10, -2, -1, -2, 10, -1, -1, -2, 5) b = Array(3, 15, 10) For i = 1 To n: y(i) = 0: Next i k = 1 For i = 1 To 3 For j = 1 To 3 a(i, j) = a1(k) k = k + 1 Next j, i For k = 1 To 30 For i = 1 To n x(i) = y(i) Next i For i = 1 To n t = 0 For j = 1 To n If i <> j Then t = t + a(i, j) * x(j) Next j y(i) = (b(i) - t) / a(i, i) Next i If cha(x, y) < 0.000000000001 Then Print k; For i = 1 To n Print y(i); Next i Exit For End If Next k If k > 30 Then Print "发散" End Sub 运行结果“19 1 2 3” Function是用来求(max|y(i)-x(i)|) 高斯—赛德尔迭代 Option Base 1 Function cha(x!(), y!()) As Single Dim z As Single, i As Single, k As Integer n = 3 z = Abs(x(1) - y(1)) For i = 2 To n If z < Abs(x(i) - y(i)) Then z = Abs(x(i) - y(i)) Next i cha = z End Function Private Sub form_click() Dim a1, x(3) As Single, y(3) As Single Dim t As Single, s As Single, a(3, 3) As Single Dim i As Integer, j As Integer, k As Integer, n As Integer n = 3 a1 = Array(10, -2, -1, -2, 10, -1, -1, -2, 5) b = Array(3, 15, 10) For i = 1 To n: x(i) = 0: Next i k = 1 For i = 1 To 3 For j = 1 To 3 a(i, j) = a1(k) k = k + 1 Next j, i For k = 1 To 30 For i = 1 To n y(i) = x(i) Next i For i = 1 To n t = 0 For j = 1 To n If i <> j Then t = t + a(i, j) * x(j) Next j x(i) = (b(i) - t) / a(i, i) Next i If cha(x, y) < 0.000000000001 Then Print k; For i = 1 To n Print x(i); Next i Exit For End If Next k If k > 30 Then Print "发散" End Sub 运行结果“11 1 2 3” 注意比较雅克比迭代、高斯—赛德尔迭代程序中“涂灰部分的区别” 实验五 3.拉格朗日插值多项式 Private Sub Form_click() Const n = 3 Dim p#, s! Dim x, y As Variant x = Array(1, 2, 3, 4) y = Array(4, 5, 14, 37) t = InputBox("input t") p = 0 For k = 0 To n s = 1 For i = 0 To n If i <> k Then s = s * ((t - x(i)) / (x(k) - x(i))) End If Next i p = p + y(k) * s Next k Print p End Sub 运行结果(t=3.5):23.375 Vb牛顿基本插值公式程序 Private Sub Form_click() Const n = 5 Dim x(n) As Single, y(n) As Single, t#, p#, s# For i = 0 To n x(i) = InputBox("input x" & Trim(Str(i))) y(i) = InputBox("input y" & Trim(Str(i))) Next i t = InputBox("input t") For k = 1 To n For i = n To k Step -1 y(i) = (y(i) - y(i - 1)) / (x(i) - x(i - k)) Next i Next k p = y(0) h = 1 For i = 1 To n h = h * (t - x(i - 1)) p = p + h * y(i) Next i Print "p="; p End Sub i 1 2 3 4 5 6 x(i) 1 3 4 5 2 6 Y(i) 2 10 17 26 5 37 运行结果(t=3.5):13.25 实验六 曲线拟合 Private Sub form_click() Dim l#, m#, n#, i%, j%, k%, t1# Dim x As Variant, y As Variant n = 7 m = 2 x = Array(0, 1, 2, 3, 4, 5, 6, 7) y = Array(0, 5, 3, 2, 1, 2, 4, 7) ReDim a(0 To m, 0 To m + 1) As Single, t(n) As Single For i = 0 To m s = 0 For k = 1 To n s = s + (x(k) ^ i) * y(k) Next k a(i, m + 1) = s For j = 0 To m s = 0 For k = 1 To n s = s + (x(k)) ^ (i + j) Next k a(i, j) = s Next j Next i For i = 0 To m For j = 0 To m + 1 Print a(i, j), Next j Print Next i For k = 0 To m r = k For i = k + 1 To m If Abs(a(i, k)) > Abs(a(r, k)) Then r = i End If Next i If r <> k Then For i = 0 To m + 1 t1 = a(k, i) a(k, i) = a(r, i) a(r, i) = t1 Next i End If l = 1 For i = k + 1 To m l = a(i, k) / a(k, k) For j = k + 1 To m + 1 a(i, j) = a(i, j) - l * a(k, j) Next j Next i Next k For k = m To 0 Step -1 s = 0 For j = k + 1 To m s = s + a(k, j) * t(j) 注意此处 Next j t(k) = (a(k, m + 1) - s) / a(k, k) Next k Print "y="; t(0); For i = 1 To m If t(i) >= 0 Then Print "+"; Print t(i); "*x^"; i; Next i End Sub 运行结果 实验七 1.编制变步长的梯形公式求数值积分的通用程序,试算积分为【积分下限为0,积分上限为1,被积函数为:1/(1+x*x)】当精度要求为0.00001时,计算结果为0.7853956. Private Sub form_click() Dim a As Single, b As Single, eps As Single, s As Single Dim x As Single, h As Single, t1 As Single, t As Single a = InputBox("输入积分下限a") b = InputBox("输入积分上限b") eps = InputBox("输入精度要求eps") h = b - a t2 = (h / 2) * (f(a) + f(b)) Do t1 = t2 s = 0 For x = a + h / 2 To b Step h s = s + f(x) Next x t2 = t1 / 2 + (h / 2) * s h = h / 2 Loop While Abs(t1 - t2) > eps Print "积分的近似值:"; t2 End Sub Function f(x As Single) As Single f = 1 / (1 + x * x) End Function 2. 复合Simpson公式求积分的通用程序,设N=8,试算例题为 积分下限为0,积分上限为1,被积函数为:1/(1+x*x),运行结果为0.785398 Private Sub form_click() Dim a As Single, b As Single, eps As Single, s As Single Dim x As Single, h As Single, N As Single a = InputBox("输入积分下限a") b = InputBox("输入积分上限b") N = 8 h = (b - a) / (2 * N) s = f(a) x = a For i = 1 To N x = x + h s = s + 4 * f(x) x = x + h s = s + 2 * f(x) Next i s = (h / 3) * (s - f(b)) Print s End Sub Function f(x As Single) As Single f = 1 / (1 + x * x) End Function 3.编制龙贝格积分公式求数值积分的通用程序,试算积分为【积分下限为0,积分上限为1,被积函数为:x * x * Exp(x)】当精度要求为0.00001时,计算结果为0.7182818 Function f!(x!) f = x * x * Exp(x) End Function Private Sub form_click() Dim a!, b!, h!, eps!, s!, t!(10, 10) Dim i%, j%, k% a = InputBox("输入积分下限") b = InputBox("输入积分上限") eps = InputBox("输入精度要求") k = 0 h = b - a t(0, 0) = (h / 2) * (f(a) + f(b)) Do k = k + 1 h = h / 2 s = 0 For j = 1 To 2 ^ (k - 1) s = s + f(a + (2 * j - 1) * h) Next j t(k, 0) = t(k - 1, 0) / 2 + h * s For i = 1 To k j = k - i t(j, i) = (4 ^ i * t(j + 1, i - 1) - t(j, i - 1)) / (4 ^ i - 1) Next i Loop Until Abs(t(0, k) - t(0, k - 1)) < eps Print "I="; t(0, k) End Sub PAGE 1
/
本文档为【东北石油大学计算方法上机实验答案】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。 本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。 网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。

历史搜索

    清空历史搜索