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

2020
Views:

159

Pages:

8
Author:

FrextWhestembki

9.14 Here is a VBA program to implement matrix multiplication and solve Prob. 9.3 for the case of [X]×[Y]. Option Explicit Sub Mult() Dim Dim Dim Dim i As Integer, j As Integer l As Integer, m As Integer, n As Integer x(10, 10) As Single, y(10, 10) As Single w(10, 10) As Single l = 2 m = 2 n = 3 x(1, 1) = 1: x(1, 2) x(2, 1) = 3: x(2, 2) x(3, 1) = 7: x(3, 2) y(1, 1) = 6: y(2, 1) y(2, 1) = 1: y(2, 2) Call Mmult(x(), y(), = 6 = 10 = 4 = 0 = 4 w(), m, n, l) For i = 1 To n For j = 1 To l MsgBox w(i, j) Next j Next i End Sub Sub Mmult(y, z, x, n, m, p) Dim i As Integer, j As Integer, k As Integer Dim sum As Single For i = 1 To m For j = 1 To p sum = 0 For k = 1 To n sum = sum + y(i, k) * z(k, j) Next k x(i, j) = sum Next j Next i End Sub 9.15 Here is a VBA program to implement the matrix transpose and solve Prob. 9.3 for the case of [X]T. Option Explicit Sub Mult() Dim i As Integer, j As Integer Dim m As Integer, n As Integer Dim x(10, 10) As Single, y(10, 10) As Single n = 3 m = 2 x(1, 1) = 1: x(1, 2) = 6 x(2, 1) = 3: x(2, 2) = 10 x(3, 1) = 7: x(3, 2) = 4 Call MTrans(x(), y(), n, m) For i = 1 To m For j = 1 To n MsgBox y(i, j) Next j Next i End Sub Sub MTrans(a, b, n, m) Dim i As Integer, j As Integer For i = 1 To m For j = 1 To n b(i, j) = a(j, i) Next j Next i End Sub 9.16 Here is a VBA program to implement the Gauss elimination algorithm and solve the test case in Prob. 9.16. Option Explicit Sub GaussElim() Dim n As Integer, er As Integer, i As Integer Dim a(10, 10) As Single, b(10) As Single, x(10) As Single Range("a1").Select n = 3 a(1, 1) = 1: a(1, 2) = 1: a(1, 3) = -1 a(2, 1) = 6: a(2, 2) = 2: a(2, 3) = 2 a(3, 1) = -3: a(3, 2) = 4: a(3, 3) = 1 b(1) = 1: b(2) = 10: b(3) = 2 Call Gauss(a(), b(), n, x(), er) If er = 0 Then For i = 1 To n MsgBox "x(" & i & ") = " & x(i) Next i Else MsgBox "ill-conditioned system" End If End Sub Sub Gauss(a, b, n, x, er) Dim i As Integer, j As Integer Dim s(10) As Single Const tol As Single = 0.000001 er = 0 For i = 1 To n s(i) = Abs(a(i, 1)) For j = 2 To n If Abs(a(i, j)) > s(i) Then s(i) = Abs(a(i, j)) Next j Next i Call Eliminate(a, s(), n, b, tol, er) If er <> -1 Then Call Substitute(a, n, b, x) End If End Sub Sub Pivot(a, b, s, n, k) Dim p As Integer, ii As Integer, jj As Integer Dim factor As Single, big As Single, dummy As Single p = k big = Abs(a(k, k) / s(k)) For ii = k + 1 To n dummy = Abs(a(ii, k) / s(ii)) If dummy > big Then big = dummy p = ii End If Next ii If p <> k Then For jj = k To n dummy = a(p, jj) a(p, jj) = a(k, jj) a(k, jj) = dummy Next jj dummy = b(p) b(p) = b(k) b(k) = dummy dummy = s(p) s(p) = s(k) s(k) = dummy End If End Sub Sub Substitute(a, n, b, x) Dim i As Integer, j As Integer Dim sum As Single x(n) = b(n) / a(n, n) For i = n - 1 To 1 Step -1 sum = 0 For j = i + 1 To n sum = sum + a(i, j) * x(j) Next j x(i) = (b(i) - sum) / a(i, i) Next i End Sub Sub Eliminate(a, s, n, b, tol, er) Dim i As Integer, j As Integer, k As Integer Dim factor As Single For k = 1 To n - 1 Call Pivot(a, b, s, n, k) If Abs(a(k, k) / s(k)) < tol Then er = -1 Exit For End If For i = k + 1 To n factor = a(i, k) / a(k, k) For j = k + 1 To n a(i, j) = a(i, j) - factor * a(k, j) Next j b(i) = b(i) - factor * b(k) Next i Next k If Abs(a(k, k) / s(k)) < tol Then er = -1 End Sub It’s application yields a solution of (1, 1, 1).