mymatrix.cls

矩阵类

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MyMatrix"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'保持属性值的局部变量
Private mvarRow As Integer '局部复制
Private mvarCol As Integer '局部复制
Dim m_Array() As Double
     
Public Property Get MyArray(ByVal i As Integer, j As Integer) As Variant
    MyArray = m_Array(i, j)
End Property
 
Public Property Let MyArray(ByVal i As Integer, j As Integer, ByVal vNewValue As Variant)
    m_Array(i, j) = vNewValue
End Property

Public Sub Init(arr() As Double, Row As Integer, Col As Integer)
    mvarRow = Row
    mvarCol = Col
    ReDim m_Array(Row, Col) As Double
    Dim i As Integer
    Dim j As Integer
    For i = 0 To Row - 1
        For j = 0 To Col - 1
            Me.MyArray(i, j) = arr(i, j)
        Next
    Next
End Sub


Public Property Get Col() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Col
    Col = mvarCol
End Property


Public Property Get Row() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Row
    Row = mvarRow
End Property


'矩阵乘以常数，它实际上相当于矩阵中所有元素都乘以此常数
Public Function MultiplyConst(ByVal c As Double) As MyMatrix
    Dim tempArr() As Double
    ReDim tempArr(Me.Row - 1, Me.Col - 1) As Double
    Dim i As Integer
    Dim j As Integer
    For i = 0 To Me.Row - 1
        For j = 0 To Me.Col - 1
            tempArr(i, j) = Me.MyArray(i, j) * c '矩阵所有元素都乘以常数c
        Next
    Next
    Dim returnMat As New MyMatrix  '新建一个矩阵类
    returnMat.Init tempArr, Me.Row, Me.Col '初始化
    Set MultiplyConst = returnMat   '返回结果
End Function
'矩阵相乘，若两矩阵满足矩阵相乘原则，则相加并返回结果矩阵，否则返回空引用
'此方法相当于 Return  Me * mat
Public Function MultiplyMatrix(ByVal mat As MyMatrix) As MyMatrix
    If Me.Col = mat.Row Then             '若满足矩阵相乘原则
        Dim tempArr() As Double
        ReDim tempArr(Me.Row - 1, mat.Col - 1) As Double
        Dim i As Integer
        Dim j As Integer
        Dim k As Integer
        For i = 0 To Me.Row - 1
            For j = 0 To mat.Col - 1
                tempArr(i, j) = 0
                For k = 0 To Me.Col - 1
                    tempArr(i, j) = tempArr(i, j) + Me.MyArray(i, k) * mat.MyArray(k, j)
                Next
            Next
        Next
        Dim returnMat As New MyMatrix
        returnMat.Init tempArr, Me.Row, mat.Col
        Set MultiplyMatrix = returnMat          '返回结果矩阵
        GoTo subend
    Else            '否则
        Set MultiplyMatrix = Nothing
        Return
    End If
subend:
End Function
'转置矩阵，返回本矩阵的转置矩阵
Public Function Transpose() As MyMatrix
    Dim tempArr() As Double
    ReDim tempArr(Me.Col - 1, Me.Row - 1) As Double
    Dim i As Integer
    Dim j As Integer
    For i = 0 To Me.Row - 1
        For j = 0 To Me.Col - 1
            tempArr(j, i) = Me.MyArray(i, j)      '行列交换，实现转置
        Next
    Next
    Dim returnMat As New MyMatrix
    returnMat.Init tempArr, Me.Col, Me.Row
    Set Transpose = returnMat     '返回结果
End Function

'返回逆矩阵Aˉ1,方阵的逆矩阵等于其行列式的倒数乘以其伴随矩阵
Public Function AMinus1() As MyMatrix
    If Me.Row <> Me.Col Then     '若此矩阵不是方阵
        Set AMinus1 = Nothing
        Return
    Else
        Dim EArr() As Double
        ReDim EArr(Me.Row - 1, Me.Col * 2 - 1) As Double
        Dim i As Integer
        Dim j As Integer
        For i = 0 To Me.Row - 1
            For j = 0 To Me.Col - 1
                EArr(i, j) = Me.MyArray(i, j)
            Next
        Next
        For i = 0 To Me.Row - 1
            For j = 0 To Me.Col - 1
                If i = j Then
                    EArr(i, j + Me.Col) = 1
                Else
                    EArr(i, j + Me.Col) = 0
                End If
            Next
        Next
        '以上构建一个扩展矩阵EArr(N,2N)
        'Me.PrintArr EArr, Me.Row, Me.Row * 2
        '以下进行初等行变换
        '应用的原理是:  [ A I]经过矩阵行变换后成为[ I ivt_A], E阵(N,2N)阶 既 [ A I]
        Dim z As Double
        For i = 0 To Me.Row - 1
            If EArr(i, i) = 0 Then  '若对角线元素为0，则通过和后面的行进行行互换使其不为0
                For j = i + 1 To Me.Row - 1
                    If EArr(j, i) <> 0 Then Exit For
                Next j
                If j = Me.Row Then  '若这一列全为0
                    Me.PrintArr EArr, Me.Row, Me.Row * 2
                    Set AMinus1 = Nothing
                    Debug.Print "Nothing"
                    GoTo subend
                Else
                    '交换i行和j行
                    Dim k As Integer
                    Dim temp As Double
                    For k = 0 To Me.Col * 2 - 1
                        temp = EArr(i, k)
                        EArr(i, k) = EArr(j, k)
                        EArr(j, k) = temp
                    Next k
                End If
            End If
            'Me.PrintArr EArr, Me.Row, Me.Row * 2
            '将i列对角线元素1化
            z = 1 / EArr(i, i)
            For k = 0 To Me.Col * 2 - 1
                EArr(i, k) = EArr(i, k) * z
            Next k
            'Me.PrintArr EArr, Me.Row, Me.Row * 2
            '将i列除对角线元素外全部0化
            For k = 0 To Me.Row - 1
                If (k <> i) And EArr(k, i) <> 0 Then  '若非对角线元素且非0
                    '化为0
                    z = EArr(k, i)
                    For j = 0 To Me.Col * 2 - 1
                        EArr(k, j) = EArr(k, j) - EArr(i, j) * z
                    Next j
                End If
            Next k
            'Me.PrintArr EArr, Me.Row, Me.Row * 2
        Next i
        i = 0
        Dim returnArr()  As Double
        ReDim returnArr(Me.Row - 1, Me.Col) As Double
        For i = 0 To Me.Row - 1
            For j = 0 To Me.Col - 1
                returnArr(i, j) = EArr(i, j + Me.Col)
            Next j
        Next i
        'Debug.Print "EArr:"
        'Me.PrintArr EArr, Me.Row, Me.Row * 2
        
        Dim returnMat As New MyMatrix
        returnMat.Init returnArr, Me.Row, Me.Col
        Set AMinus1 = returnMat
    End If
subend:
End Function

'返回最小二乘矩阵逆Alˉ，Alˉ = （（A的转置 * A）的逆矩阵） * A的转置
Public Function AlMinus() As MyMatrix
    Dim AT As MyMatrix          'A的转置
    Dim AT_M_A As MyMatrix      'A的转置 * A
    Dim ivt_AT_M_A As MyMatrix  '（A的转置 * A）的逆矩阵
    Dim resultMat As MyMatrix
    Set AT = Me.Transpose
    Debug.Print "AT"
    AT.PrintMatrix
    Set AT_M_A = AT.MultiplyMatrix(Me)
    Debug.Print "AT_M_A"
    AT_M_A.PrintMatrix
    Set ivt_AT_M_A = AT_M_A.AMinus1
    Debug.Print "ivt_AT_M_A"
    ivt_AT_M_A.PrintMatrix
    Set resultMat = ivt_AT_M_A.MultiplyMatrix(AT)
    Set AlMinus = resultMat
End Function


Public Sub PrintMatrix()
    Dim i As Integer
    Dim j As Integer
    Dim str As String
    For i = 0 To Me.Row - 1
        For j = 0 To Me.Col - 1
            str = str & Me.MyArray(i, j) & vbTab
        Next
        str = str & vbLf
    Next
    Debug.Print str
End Sub
Public Sub PrintArr(arr() As Double, m As Integer, n As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim str As String
    For i = 0 To m - 1
        For j = 0 To n - 1
            str = str & arr(i, j) & " "
        Next
        str = str & vbLf
    Next
    Debug.Print str
End Sub