matrixmodule.bas

科学与工程数值计算算法（Visual Basic版） 附赠的光盘包含了本书中全部的源代码

Attribute VB_Name = "MatrixModule"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  功能：  矩阵运算
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MatrixToString
'  功能：  将矩阵转换为显示字符串
'  参数：  m   - Integer型变量，矩阵的行数
'          n   - Integer型变量，矩阵的列数
'          mtxA  - Double型m x n二维数组，存放相加的左边矩阵
'          sFormat - 显示矩阵各元素的格式控制字符串
'  返回值：String型，显示矩阵的字符串
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MatrixToString(m As Integer, n As Integer, mtxA() As Double, sFormat As String) As String
    Dim i As Integer, j As Integer
    Dim s As String

    s = ""
    For i = 1 To m
        For j = 1 To n
            s = s + Format(mtxA(i, j), sFormat) + "  "
        Next j
        s = s + Chr(13)
    Next i
    
    MatrixToString = s

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MatrixRowToString
'  功能：  将矩阵的指定行转换为显示字符串
'  参数：  n   - Integer型变量，矩阵的列数
'          r   - Integer型变量，要显示的矩阵的行数
'          mtxA  - Double型m x n二维数组，存放相加的左边矩阵
'          sFormat - 显示矩阵各元素的格式控制字符串
'  返回值：String型，显示矩阵指定的行向量
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MatrixRowToString(n As Integer, r As Integer, mtxA() As Double, sFormat As String) As String
    Dim i As Integer, j As Integer
    Dim s As String

    s = ""
    For j = 1 To n
        s = s + Format(mtxA(r, j), sFormat) + "  "
    Next j

    MatrixRowToString = s

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MatrixColToString
'  功能：  将矩阵的指定列转换为显示字符串
'  参数：  m   - Integer型变量，矩阵的行数
'          c   - Integer型变量，要显示的矩阵的列数
'          mtxA  - Double型m x n二维数组，存放相加的左边矩阵
'          sFormat - 显示矩阵各元素的格式控制字符串
'  返回值：String型，显示矩阵指定的列向量
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MatrixColToString(m As Integer, c As Integer, mtxA() As Double, sFormat As String) As String
    Dim i As Integer, j As Integer
    Dim s As String

    s = ""
    For i = 1 To m
        s = s + Format(mtxA(i, c), sFormat) + "  "
    Next i

    MatrixColToString = s

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MAdd
'  功能：  计算矩阵的加法
'  参数：  m   - Integer型变量，矩阵的行数
'          n   - Integer型变量，矩阵的列数
'          mtxA  - Double型m x n二维数组，存放相加的左边矩阵
'          mtxB  - Double型m x n二维数组，存放相加的右边矩阵
'          mtxC  - Double型m x n二维数组，返回和矩阵
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MAdd(m As Integer, n As Integer, mtxA() As Double, mtxB() As Double, mtxC() As Double)
    Dim i As Integer, j As Integer

    For i = 1 To m
        For j = 1 To n
            mtxC(i, j) = mtxA(i, j) + mtxB(i, j)
        Next j
    Next i

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MSub
'  功能：  计算矩阵的减法
'  参数：  m   - Integer型变量，矩阵的行数
'          n   - Integer型变量，矩阵的列数
'          mtxA  - Double型m x n二维数组，存放相减的左边矩阵
'          mtxB  - Double型m x n二维数组，存放相减的右边矩阵
'          mtxC  - Double型m x n二维数组，返回差矩阵
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MSub(m As Integer, n As Integer, mtxA() As Double, mtxB() As Double, mtxC() As Double)
    Dim i As Integer, j As Integer

    For i = 1 To m
        For j = 1 To n
            mtxC(i, j) = mtxA(i, j) + mtxB(i, j)
        Next j
    Next i

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MNmul
'  功能：  计算矩阵的数乘
'  参数：  m   - Integer型变量，矩阵的行数
'          n   - Integer型变量，矩阵的列数
'          dblNum  - Double型变量，乘数
'          mtxA  - Double型m x n二维数组，存放乘数矩阵
'          mtxB  - Double型m x n二维数组，存放数乘的结果矩阵
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MNmul(m As Integer, n As Integer, dblNum As Double, mtxA() As Double, mtxB() As Double)
    Dim i As Integer, j As Integer

    For i = 1 To m
        For j = 1 To n
            mtxB(i, j) = dblNum * mtxA(i, j)
        Next j
    Next i

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MTrans
'  功能：  计算矩阵的转置
'  参数：  m   - Integer型变量，矩阵的行数
'          n   - Integer型变量，矩阵的列数
'          mtxA  - Double型m x n二维数组，存放原矩阵
'          mtxAT  - Double型n x m二维数组，返回转置矩阵
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MTrans(m As Integer, n As Integer, mtxA() As Double, mtxAT() As Double)
    Dim i As Integer, j As Integer

    For i = 1 To m
        For j = 1 To n
            mtxAT(i, j) = mtxAT(j, i)
        Next j
    Next i

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MMul
'  功能：  计算矩阵的乘法
'  参数：  m   - Integer型变量，相乘的左边矩阵的行数
'          n   - Integer型变量，相乘的左边矩阵的列数和右边矩阵的行数
'          l   -  Integer型变量，相乘的右边矩阵的列数
'          mtxA  - Double型m x n二维数组，存放相乘的左边矩阵
'          mtxB  - Double型n x l二维数组，存放相乘的右边矩阵
'          mtxC  - Double型m x l二维数组，返回矩阵乘积矩阵
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MMul(m As Integer, n As Integer, l As Integer, mtxA() As Double, mtxB() As Double, mtxC() As Double)
    Dim i As Integer, j As Integer, k As Integer

    For i = 1 To m
        For j = 1 To l
            mtxC(i, j) = 0#
            For k = 1 To n
                mtxC(i, j) = mtxC(i, j) + mtxA(i, k) * mtxB(k, j)
            Next k
        Next j
    Next i

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MCmul
'  功能：  计算复矩阵乘法
'  参数：  m   - Integer型变量，相乘的左边矩阵的行数
'          n   - Integer型变量，相乘的左边矩阵的列数和右边矩阵的行数
'          l   -  Integer型变量，相乘的右边矩阵的列数
'          mtxAR  - Double型m x n二维数组，存放相乘的左边矩阵的实部
'          mtxAI  - Double型m x n二维数组，存放相乘的左边矩阵的虚部
'          mtxBR  - Double型n x l二维数组，存放相乘的右边矩阵的实部
'          mtxBI  - Double型n x l二维数组，存放相乘的右边矩阵的虚部
'          mtxCR  - Double型m x l二维数组，返回矩阵乘积矩阵的实部
'          mtxCI  - Double型m x l二维数组，返回矩阵乘积矩阵的虚部
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MCmul(m As Integer, n As Integer, l As Integer, mtxAR() As Double, mtxAI() As Double, _
mtxBR() As Double, mtxBI() As Double, mtxCR() As Double, mtxCI() As Double)
    Dim i As Integer, j As Integer, k As Integer
    Dim p As Double, q As Double, s As Double

    For i = 1 To m
        For j = 1 To l
            mtxCR(i, j) = 0#
            mtxCI(i, j) = 0#
            For k = 1 To n
                p = mtxAR(i, k) * mtxBR(k, j)
                q = mtxAI(i, k) * mtxBI(k, j)
                s = (mtxAR(i, k) + mtxAI(i, k)) * (mtxBR(k, j) + mtxBI(k, j))
                mtxCR(i, j) = mtxCR(i, j) + p - q
                mtxCI(i, j) = mtxCI(i, j) + s - p - q
            Next k
        Next j
    Next i

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MRinv
'  功能：  实矩阵求逆的全选主元高斯－约当法
'  参数：  n      - Integer型变量，矩阵的阶数
'          mtxA   - Double型二维数组，体积为n x n。存放原矩阵A；返回时存放其逆矩阵A-1。
'  返回值：Boolean型，失败为False，成功为True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MRinv(n As Integer, mtxA() As Double) As Boolean
    ' 局部变量
    ReDim nIs(n) As Integer, nJs(n) As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim d As Double, p As Double

    ' 全选主元，消元
    For k = 1 To n
        d = 0#
        For i = k To n
            For j = k To n
                p = Abs(mtxA(i, j))
                If (p > d) Then
                    d = p
                    nIs(k) = i
                    nJs(k) = j
                End If
            Next j
        Next i
        
        ' 求解失败
        If (d + 1# = 1#) Then
            MRinv = False
            Exit Function
        End If

        If (nIs(k) <> k) Then
            For j = 1 To n
                p = mtxA(k, j)
                mtxA(k, j) = mtxA(nIs(k), j)
                mtxA(nIs(k), j) = p
            Next j
        End If

        If (nJs(k) <> k) Then
            For i = 1 To n
                p = mtxA(i, k)
                mtxA(i, k) = mtxA(i, nJs(k))
                mtxA(i, nJs(k)) = p
            Next i
        End If

        mtxA(k, k) = 1# / mtxA(k, k)
        For j = 1 To n
            If (j <> k) Then mtxA(k, j) = mtxA(k, j) * mtxA(k, k)
        Next j
        For i = 1 To n
            If (i <> k) Then
                For j = 1 To n
                    If (j <> k) Then mtxA(i, j) = mtxA(i, j) - mtxA(i, k) * mtxA(k, j)
                Next j
            End If
        Next i
        For i = 1 To n
            If (i <> k) Then mtxA(i, k) = -mtxA(i, k) * mtxA(k, k)
        Next i
    Next k

    ' 调整恢复行列次序
    For k = n To 1 Step -1
        If (nJs(k) <> k) Then
          For j = 1 To n
              p = mtxA(k, j)
              mtxA(k, j) = mtxA(nJs(k), j)
              mtxA(nJs(k), j) = p
          Next j
        End If
        If (nIs(k) <> k) Then
          For i = 1 To n
              p = mtxA(i, k)
              mtxA(i, k) = mtxA(i, nIs(k))
              mtxA(i, nIs(k)) = p
          Next i
        End If
    Next k
    
    ' 求解成功
    MRinv = True

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：MatrixModule.bas
'  函数名：MCinv
'  功能：  实矩阵求逆的全选主元高斯－约当法
'  参数：  n      - Integer型变量，矩阵的阶数
'          mtxAR   - Double型二维数组，体积为n x n。存放原矩阵A的实部；返回时存放其逆矩阵A-的实部。
'          mtxAI   - Double型二维数组，体积为n x n。存放原矩阵A的虚部；返回时存放其逆矩阵A-的虚部。
'  返回值：Boolean型，失败为False，成功为True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MCinv(n As Integer, mtxAR() As Double, mtxAI() As Double) As Boolean
    ' 局部变量
    ReDim nIs(n) As Integer, nJs(n) As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim d As Double, p As Double, s As Double, t As Double, q As Double, b As Double

    ' 全选主元，消元
    For k = 1 To n
        d = 0#
        For i = k To n
            For j = k To n
                p = mtxAR(i, j) * mtxAR(i, j) + mtxAI(i, j) * mtxAI(i, j)
                If (p > d) Then
                    d = p
                    nIs(k) = i
                    nJs(k) = j
                End If
            Next j