University:
Kentucky State University
Course:
COS 232| Programming I
Academic year:

2019
Views:

62

Pages:

8
Author:

salcignofi16

22.11 Option Explicit Sub RhombTest() Dim maxit As Integer Dim a As Single, b As Single, es As Single a = 0 b = 0.8 maxit = 3 es = 0.001 MsgBox Rhomberg(a, b, maxit, es) End Sub Function Rhomberg(a, b, maxit, es) Dim n As Integer, j As Integer, k As Integer, iter As Integer Dim i(10, 10) As Single, ea As Single n = 1 i(1, 1) = TrapEq(n, a, b) iter = 0 Do iter = iter + 1 n = 2 ^ iter i(iter + 1, 1) = TrapEq(n, a, b) For k = 2 To iter + 1 j = 2 + iter - k i(j, k) = (4 ^ (k - 1) * i(j + 1, k - 1) - i(j, k - 1)) / (4 ^ (k - 1) - 1) Next k ea = Abs((i(1, iter + 1) - i(1, iter)) / i(1, iter + 1)) * 100 If (iter >= maxit Or ea <= es) Then Exit Do Loop Rhomberg = i(1, iter + 1) End Function Function TrapEq(n, a, b) Dim i As Integer Dim h As Single, x As Single, sum As Single h = (b - a) / n x = a sum = f(x) For i = 1 To n - 1 x = x + h sum = sum + 2 * f(x) Next i sum = sum + f(b) TrapEq = (b - a) * sum / (2 * n) End Function Function f(x) f = 0.2 + 25 * x - 200 * x ^ 2 + 675 * x ^ 3 - 900 * x ^ 4 + 400 * x ^ 5 End Function 22.12 Option Explicit Sub Dim Dim Dim GaussQuadTest() i As Integer, j As Integer, k As Integer a As Single, b As Single, a0 As Single, a1 As Single, sum As Single c(11) As Single, x(11) As Single, j0(5) As Single, j1(5) As Single 'set constants c(1) = 1#: c(2) = 0.888888889: c(3) = 0.555555556: c(4) = 0.652145155 c(5) = 0.347854845: c(6) = 0.568888889: c(7) = 0.478628671: c(8) 0.236926885 c(9) = 0.467913935: c(10) = 0.360761573: c(11) = 0.171324492 x(1) = 0.577350269: x(2) = 0: x(3) = 0.774596669: x(4) = 0.339981044 x(5) = 0.861136312: x(6) = 0: x(7) = 0.53846931: x(8) = 0.906179846 x(9) = 0.238619186: x(10) = 0.661209386: x(11) = 0.932469514 j0(1) = 1: j0(2) = 3: j0(3) = 4: j0(4) = 7: j0(5) = 9 j1(1) = 1: j1(2) = 3: j1(3) = 5: j1(4) = 8: j1(5) = 11 a = 0 b = 0.8 Sheets("Sheet1").Select Range("a1").Select For i = 1 To 5 ActiveCell.Value = GaussQuad(i, a, b, c(), x(), j0(), j1()) ActiveCell.Offset(1, 0).Select Next i End Sub Function GaussQuad(n, a, b, c, x, j0, j1) Dim k As Integer, j As Integer Dim a0 As Single, a1 As Single Dim sum As Single a0 = (b + a) / 2 a1 = (b - a) / 2 sum = 0 If Int(n / 2) - n / 2# = 0 Then k = (n - 1) * 2 sum = sum + c(k) * a1 * f(fc(x(k), a0, a1)) End If For j = j0(n) To j1(n) sum = sum + c(j) * a1 * f(fc(-x(j), a0, a1)) sum = sum + c(j) * a1 * f(fc(x(j), a0, a1)) Next j GaussQuad = sum End Function Function fc(xd, a0, a1) fc = a0 + a1 * xd End Function Function f(x) f = 0.2 + 25 * x - 200 * x ^ 2 + 675 * x ^ 3 - 900 * x ^ 4 + 400 * x ^ 5 End Function = 22.13 See solutions for Probs. 22.1, 22.2 and 22.3 for answers 22.14 See solutions for Probs. 22.4, 22.5 and 22.6 for answers 22.15 Option Explicit Sub TestMidPoint() Dim Dim Dim Dim i As Integer, j As Integer, d As Integer a As Single, b As Single, h As Single, x As Single sum As Single, ea As Single, es As Single integral As Single, integralold As Single a = -0.5 b = 0 es = 0.01 Range("a5").Select Sheets("Sheet1").Range("a5:d25").ClearContents Do integralold = integral d = 3 ^ i h = (b - a) / d x = a - h / 2 sum = 0 ActiveCell.Value = d ActiveCell.Offset(0, 1).Select ActiveCell.Value = h ActiveCell.Offset(0, 1).Select For j = 1 To d x = x + h sum = sum + f(x) Next j integral = sum * h i = i + 1 ActiveCell.Value = integral ActiveCell.Offset(0, 1).Select ea = Abs((integral - integralold) / integral) * 100 ActiveCell.Value = ea ActiveCell.Offset(1, -3).Select If ea < es Then Exit Do Loop End Sub Function f(x) f = 1 / x ^ 2 * Exp(-1 / (2 * x ^ 2)) End Function