muavmainmodule.bas

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

BAS
37
字号
Attribute VB_Name = "MainModule"
Sub Main()
    Dim mtxA(4, 3) As Double
    Dim mtxU(4, 4) As Double
    Dim mtxV(3, 3) As Double
    Dim mtxB(4, 3) As Double
    Dim mtxC(4, 3) As Double
    
    ' 原矩阵赋值
    mtxA(1, 1) = 1: mtxA(1, 2) = 1: mtxA(1, 3) = -1
    mtxA(2, 1) = 2: mtxA(2, 2) = 1: mtxA(2, 3) = 0
    mtxA(3, 1) = 1: mtxA(3, 2) = -1: mtxA(3, 3) = 0
    mtxA(4, 1) = -1: mtxA(4, 2) = 2: mtxA(4, 3) = 1

    '求解
    If MUav(4, 3, mtxA, mtxU, mtxV, 5, 0.000001) Then
    
        ' 矩阵乘法 U*A
        Call MMul(4, 4, 3, mtxU, mtxA, mtxB)
        ' 矩阵乘法 (U*A)*V
        Call MMul(4, 3, 3, mtxB, mtxV, mtxC)
        
        MsgBox "求解成功!" & Chr$(13) & Chr$(13) & _
                "矩阵U" & Chr$(13) & Chr$(13) & _
                MatrixToString(4, 4, mtxU, "######0.0000000") & Chr$(13) & _
                "矩阵V" & Chr$(13) & Chr$(13) & _
                MatrixToString(3, 3, mtxV, "######0.0000000") & Chr$(13) & _
                "奇异值矩阵" & Chr$(13) & Chr$(13) & _
                MatrixToString(4, 3, mtxA, "######0.0000000") & Chr$(13) & _
                "UAV" & Chr$(13) & Chr$(13) & _
                MatrixToString(4, 3, mtxC, "######0.0000000")
    Else
        MsgBox "求解失败!"
    End If
    
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?