minvmainmodule.bas

来自「各种矩阵运算」· BAS 代码 · 共 53 行

Attribute VB_Name = "MainModule"
Sub Main()
    Dim mtxA(5, 4) As Double
    Dim mtxAP(4, 5) As Double
    Dim mtxU(5, 5) As Double
    Dim mtxV(4, 4) As Double
    Dim mtxB(5, 4) As Double
    Dim mtxC(5, 4) As Double
    Dim mtxD(4, 5) As Double
    Dim i As Integer, j As Integer
    
    ' 原矩阵
    mtxA(1, 1) = 1: mtxA(1, 2) = 2: mtxA(1, 3) = 3: mtxA(1, 4) = 4
    mtxA(2, 1) = 6: mtxA(2, 2) = 7: mtxA(2, 3) = 8: mtxA(2, 4) = 9
    mtxA(3, 1) = 1: mtxA(3, 2) = 2: mtxA(3, 3) = 13: mtxA(3, 4) = 0
    mtxA(4, 1) = 16: mtxA(4, 2) = 17: mtxA(4, 3) = 8: mtxA(4, 4) = 9
    mtxA(5, 1) = 2: mtxA(5, 2) = 4: mtxA(5, 3) = 3: mtxA(5, 4) = 4

    ' 备份原矩阵
    For i = 1 To 5
        For j = 1 To 4
            mtxC(i, j) = mtxA(i, j)
        Next j
    Next i
    
    '求解A+
    If MInv(5, 4, mtxA, mtxAP, mtxU, mtxV, 6, 0.000001) Then
        ' 备份矩阵A+
        For i = 1 To 4
            For j = 1 To 5
                mtxD(i, j) = mtxAP(i, j)
            Next j
        Next i
        
        '求解(A+)+
        If MInv(4, 5, mtxAP, mtxB, mtxV, mtxU, 6, 0.000001) Then
            MsgBox "求解成功！" & Chr$(13) & Chr$(13) & _
                    "原矩阵A" & Chr$(13) & Chr$(13) & _
                    MatrixToString(5, 4, mtxC, "######0.0000000") & Chr$(13) & Chr$(13) & _
                    "矩阵A+" & Chr$(13) & Chr$(13) & _
                    MatrixToString(4, 5, mtxD, "######0.0000000") & Chr$(13) & Chr$(13) & _
                    "矩阵(A+)+" & Chr$(13) & Chr$(13) & _
                    MatrixToString(5, 4, mtxB, "######0.0000000")
        Else
            MsgBox "验证失败！"
        End If
        
    Else
        MsgBox "求解失败！"
    End If
    
End Sub