mdlmatrix.bas

制作矩阵的控件。

                    For m = i + 1 To j
                        If Temp.Element(i, i) = 0 Then
                            Determinant = 0 '秩亏方阵
                            Exit Function
                        Else
                            If Temp.Element(m, m) - Temp.Element(m, i) / Temp.Element(i, i) * Temp.Element(i, m) = 0 Then
                                For y = 1 To j
                                    If Not Temp.Element(y, i) = 0 Then
                                        For x = 1 To j
                                            Temp.Element(m, x) = Temp.Element(m, x) + Temp.Element(m + 1, x)
                                        Next x
                                    End If
                                Next y
                            End If
                            Mult = Temp.Element(m, i) / Temp.Element(i, i)
                        End If
                            
                        For n = i To j   '调整元素的列
                            Temp.Element(m, n) = Temp.Element(m, n) - (Mult * Temp.Element(i, n))
                        Next n
                    Next m
                    
                    '将上三角矩阵的各对角线元素相乘得出方阵的行列式
                    det = det * Temp.Element(i, i)
                Next i
        End Select
    End With
    Determinant = det
End Function


Public Function InvertMatrix(ByRef dMat As Matrix) As Matrix
    ' 求矩阵的逆，矩阵必须为方阵，行列式为0没有逆矩阵
    '矩阵的逆定义为一矩阵与其逆矩阵相乘所得矩阵为单位矩阵，形如：
    ' [ a b c ]   [ a b c ]-1    [ 1 0 0 ]
    ' [ d e f ] * [ d e f ]   => [ 0 1 0 ]
    ' [ g h i ]   [ g h i ]      [ 0 0 1 ]
    
    Dim i As Integer, j As Integer
    Dim x As Integer, y As Integer
    Dim size As Integer, Sine As Integer
    Dim Temp As Matrix, sMat As Matrix
    Dim det As Double
    
    With dMat
        i = .n
        j = .m
        size = j
        
        Select Case True
            Case i <> j
                MsgBox "矩阵不为方阵，不能求逆", , "矩阵操作 - 矩阵求逆"
                Exit Function
            Case i = 1
                InvertMatrix = CreateMatrix(1, 1, 1 / .Element(1, 1))
        End Select
            
        det = Determinant(dMat)
        
        Select Case True
            Case det = 0
                MsgBox "不能对零维矩阵求逆", , "矩阵操作 - 矩阵求逆"
                Exit Function
            Case i = 2
                ' 直接计算二维矩阵的逆矩阵
                Temp = CreateMatrix(2, 2, .Element(2, 2), -.Element(1, 2), -.Element(2, 1), .Element(1, 1))
                InvertMatrix = ScaleMatrix(Temp, 1 / det)
                Exit Function
        End Select
        
        Temp = CreateMatrix(size, size)
        
        For i = 1 To size
            For j = 1 To size
                sMat = SubMat(dMat, i, j)
                Sine = (-1) ^ (i + j)
                Temp.Element(i, j) = Determinant(sMat) * Sine
            Next j
        Next i
    End With
    Temp = TransposeMatrix(Temp) '将C矩阵转置
    InvertMatrix = ScaleMatrix(Temp, 1 / det) '将C矩阵除以行列式
End Function


Public Function InsertMatrix(ByRef dMatDest As Matrix, ByRef dMatSrc As Matrix, ByVal mPos As Integer, ByVal nPos As Integer) As Matrix
    ' 插入一个子矩阵到一个大矩阵当中，并将其对应元素替换，插入形式如下：
    ' [ a b c ]                [ a b c ]
    ' [ d e f ] <- [ w x ]  =  [ d w x ]
    ' [ g h i ]    [ y z ]     [ g y z ]
    ' mPos和nPos是子矩阵拟插入到源矩阵中的行数和列数
   
    Dim i As Integer, j As Integer
    Dim MaxRow As Integer, MaxCol As Integer
    Dim Temp As Matrix
    
    Temp = dMatDest
    
    With dMatSrc
        i = Temp.m
        j = Temp.n
        
        '替换操作
        MaxRow = IIf(.m >= i, i - .m + 1, IIf(.m < i, .m, i))
        MaxCol = IIf(.n >= j, j - .n + 1, IIf(.n < j, .n, j))
        
        mPos = mPos - 1
        nPos = nPos - 1
        
        For i = 1 To MaxRow ' 将各元素写入矩阵中
            For j = 1 To MaxCol
                Temp.Element(i + mPos, j + nPos) = .Element(i, j)
            Next j
        Next i
    End With
    
    InsertMatrix = Temp
End Function


Public Function CombineMatrix(ByRef dMatDest As Matrix, ByRef dMatSrc As Matrix, ByVal mPos As Integer, ByVal nPos As Integer) As Matrix
    ' 将一子矩阵插入到一大矩阵，并将其对应元素相加，插入形式如下：
    ' [ a b c ]                [ a   b   c  ]
    ' [ d e f ] <+ [ w x ]  =  [ d  e+w f+x ]
    ' [ g h i ]    [ y z ]     [ g  h+y i+z ]
    '
   
    Dim i As Integer, j As Integer
    Dim MaxRow As Integer, MaxCol As Integer
    Dim Temp As Matrix
    
    Temp = dMatDest
    
    With dMatSrc
        i = Temp.m
        j = Temp.n
        
        MaxRow = IIf(.m >= i, i - .m + 1, IIf(.m < i, .m, i))
        MaxCol = IIf(.n >= j, j - .n + 1, IIf(.n < j, .n, j))
        
        mPos = mPos - 1
        nPos = nPos - 1
        
        For i = 1 To MaxRow  ' 对应元素相加
            For j = 1 To MaxCol
                Temp.Element(i + mPos, j + nPos) = Temp.Element(i + mPos, j + nPos) + .Element(i, j)
            Next j
        Next i
    End With
    
    CombineMatrix = Temp
End Function



Public Function SwapRow(ByRef dMat As Matrix, ByVal RowA As Integer, ByVal RowB As Integer) As Matrix
    ' 矩阵两行互换，互换形式如下：
    ' [ a b c ]                        [ a b c ]
    ' [ d e f ] (矩阵第2行\ 第3行互换)  [ g h i ]
    ' [ g h i ]                        [ d e f ]
    
    Dim Temp As Matrix
    Dim i As Integer, e As Double
    
    Temp = dMat
    
    ' 元素交换
    With Temp
        For i = 1 To dMat.m
            e = .Element(RowA, i)
            .Element(RowA, i) = .Element(RowB, i)
            .Element(RowB, i) = e
        Next i
    End With
    
    SwapRow = Temp
End Function



Public Function SwapCol(ByRef dMat As Matrix, ByVal ColA As Integer, ByVal ColB As Integer) As Matrix
    ' 矩阵两列互换，交换形式如下：
    ' [ a b c ]                          [ c b a ]
    ' [ d e f ] (矩阵1、3列互换)          [ f e d ]
    ' [ g h i ]                          [ i h g ]
    
    Dim Temp As Matrix
    Dim j As Integer, e As Double
    
    Temp = dMat
    
    '元素交换
    With Temp
        For j = 1 To dMat.n
            e = .Element(j, ColA)
            .Element(j, ColA) = .Element(j, ColB)
            .Element(j, ColB) = e
        Next j
    End With
    
    SwapCol = Temp
End Function


Public Function SubMat(ByRef dMat As Matrix, ByVal eRow As Integer, ByVal eCol As Integer) As Matrix
    ' 返回子矩阵，子矩阵是通过去除已知矩阵的给定行和给定列的值重新构造矩阵来获得的
    ' 例如:
    '      *
    '  [ a b c d ]       [ a * c d ]     [ a c d ]
    ' *[ e f g h ]*  --> [ * * * * ] --> [ i k l ]
    '  [ i j k l ]       [ i * k l ]     [ m o p ]
    '  [ m n o p ]       [ m * o p ]
    '      *
    
    Dim Temp As Matrix
    Dim oldrow As Integer, oldcol As Integer
    Dim x As Integer, y As Integer
    Dim m As Integer, n As Integer
    
    
    With dMat
        m = .m
        n = .n
        Temp = CreateMatrix(m - 1, n - 1)
        
        '从原始矩阵拷贝出子矩阵
        oldrow = 0
        For x = 1 To m - 1
            If x = eRow Then oldrow = oldrow + 2 Else oldrow = oldrow + 1
            oldcol = 0
            
            For y = 1 To n - 1
                If y = eCol Then oldcol = oldcol + 2 Else oldcol = oldcol + 1
                Temp.Element(x, y) = .Element(oldrow, oldcol)
            Next y
        Next x
    
    End With
    
    SubMat = Temp
End Function


Public Sub PrintMatrix(ByRef dMat As Matrix)
    ' 使用debugging, 将矩阵元素输入到立即窗口
    Dim i As Integer, j As Integer
    With dMat
        For i = 1 To .m
            For j = 1 To .n
                Debug.Print Format(.Element(i, j), "#####0.0000000"),
            Next j
            Debug.Print
        Next i
    End With
    Debug.Print
End Sub