matrix.bas

PQ分解法

Attribute VB_Name = "matrix"
Public Function IM(NoMatrix As Integer, matrix() As Double, ByRef IMatrix() As Double) '逆矩阵
    ReDim b(1 To NoMatrix) As Double
    ReDim xxx(1 To NoMatrix) As Double
    Dim temp() As Double
    ReDim temp(1 To NoMatrix, 1 To NoMatrix) As Double
    Dim Y As Integer
    Dim X As Integer
    For X = 1 To NoMatrix
        For Y = 1 To NoMatrix
            temp(X, Y) = matrix(X, Y)
        Next Y
    Next X
    
    Dim i As Integer
    Dim j As Integer
    For i = 1 To NoMatrix
        ReDim b(1 To NoMatrix) As Double
        ReDim xxx(1 To NoMatrix) As Double
        b(i) = 1
        For X = 1 To NoMatrix
            For Y = 1 To NoMatrix
              matrix(X, Y) = temp(X, Y)
            Next Y
        Next X
        Call Line_F(NoMatrix, matrix, b, xxx)
        For j = 1 To NoMatrix
            IMatrix(j, i) = xxx(j)
        Next j
    Next i
End Function

Public Function TransMatrix(NoMatrix As Integer, matrix() As Double, ByRef TMatrix() As Double) '方块矩阵的转置
    Dim i As Integer
    Dim j As Integer
    For i = 1 To NoMatrix
        For j = 1 To NoMatrix
            TMatrix(i, j) = matrix(j, i)
        Next j
    Next i
End Function

Public Function TransMatrixNo(mMatrix As Integer, nMatrix As Integer, matrix() As Double, ByRef TMatrix() As Double) '非方块矩阵的转置
    Dim i As Integer
    Dim j As Integer
    For i = 1 To nMatrix
        For j = 1 To mMatrix
            TMatrix(i, j) = matrix(j, i)
        Next j
    Next i
End Function

Public Function MatrixPlus(mMatrix As Integer, nMatrix As Integer, amatrix() As Double, bmatrix() As Double, ByRef xmatrix() As Double) '矩阵的相加
    Dim i As Integer
    Dim j As Integer
    For i = 1 To mMatrix
        For j = 1 To nMatrix
            xmatrix(i, j) = amatrix(i, j) + bmatrix(i, j)
        Next j
    Next i
End Function

Public Function MatrixSub(mMatrix As Integer, nMatrix As Integer, amatrix() As Double, bmatrix() As Double, ByRef xmatrix() As Double) '矩阵的相减
    Dim i As Integer
    Dim j As Integer
    For i = 1 To mMatrix
        For j = 1 To nMatrix
            xmatrix(i, j) = amatrix(i, j) - bmatrix(i, j)
        Next j
    Next i
End Function

Public Function MatrixNe(mMatrix As Integer, nMatrix As Integer, amatrix() As Double, ByRef xmatrix() As Double) '求负
    Dim i As Integer
    For i = 1 To mMatrix
        For j = 1 To nMatrix
            xmatrix(i, j) = -amatrix(i, j)
        Next j
    Next i
End Function

Public Function MatrixMul(mMatrix As Integer, nMatrix As Integer, lMatrix As Integer, amatrix() As Double, bmatrix() As Double, ByRef xmatrix() As Double) ''矩阵的相乘
    Dim i As Integer
    Dim j As Integer
    Dim q As Integer
    For i = 1 To mMatrix 'a行
        For j = 1 To lMatrix 'b列
            For q = 1 To nMatrix 'a列
                xmatrix(i, j) = xmatrix(i, j) + amatrix(i, q) * bmatrix(q, j)
            Next q
        Next j
    Next i
End Function