msymtrieigenvmainmodule.bas

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

Attribute VB_Name = "MainModule"
Sub Main()
    Dim mtxA(5, 5) As Double
    Dim mtxQ(5, 5) As Double
    Dim mtxT(5, 5) As Double
    Dim dblB(5) As Double, dblC(5) As Double
    Dim sEigenValue As String, sEigenVector As String
    Dim i As Integer
    
    ' 原矩阵
    mtxA(1, 1) = 10:  mtxA(1, 2) = 1: mtxA(1, 3) = 2:  mtxA(1, 4) = 3: mtxA(1, 5) = 4
    mtxA(2, 1) = 1:  mtxA(2, 2) = 9: mtxA(2, 3) = -1:  mtxA(2, 4) = 2: mtxA(2, 5) = -3
    mtxA(3, 1) = 2:  mtxA(3, 2) = -1: mtxA(3, 3) = 7:  mtxA(3, 4) = 3: mtxA(3, 5) = -5
    mtxA(4, 1) = 3:  mtxA(4, 2) = 2: mtxA(4, 3) = 3:  mtxA(4, 4) = 12: mtxA(4, 5) = -1
    mtxA(5, 1) = 4:  mtxA(5, 2) = -3: mtxA(5, 3) = -5:  mtxA(5, 4) = -1: mtxA(5, 5) = 15


    '求解对称三对角矩阵
    Call MSymTri(5, mtxA, mtxQ, mtxT, dblB, dblC)
    
    '求解对称三对角矩阵的特征值和特征向量
    If MSymTriEigenv(5, dblB, dblC, mtxQ, 0.000001, 60) Then
        
        ' 特征值和特征向量
        For i = 1 To 5
            sEigenValue = sEigenValue & i & ": " & Format(dblB(i), "######0.0000000") & Chr(13)
            sEigenVector = sEigenVector & i & ": " & MatrixColToString(5, i, mtxQ, "######0.0000000") & Chr(13)
        Next i
        
        MsgBox "求解成功！" & Chr$(13) & Chr$(13) & _
                "原矩阵A" & Chr$(13) & Chr$(13) & _
                MatrixToString(5, 5, mtxA, "######0.0000000") & Chr$(13) & _
                "特征值" & Chr$(13) & Chr$(13) & _
                sEigenValue & Chr$(13) & _
                "特征向量" & Chr$(13) & Chr$(13) & _
                sEigenVector
    Else
        MsgBox "求解失败！"
    End If
        
End Sub