矩阵和向量计算的vb.net类模块.txt

适用于vb.net的矩阵运算

            Next

            For LCA = 0 To LL
                If LCA = LC Then GoTo 1150
                AF = Mat1(LC, LCA)
                For LCB = 0 To LL
                    Mat1(LCB, LCA) = Mat1(LCB, LCA) - AF * Mat1(LCB, LC)
                    AI(LCB, LCA) = AI(LCB, LCA) - AF * AI(LCB, LC)
                Next
1150:       Next

        Next

        Return AI

Error_Zero:
        Err.Raise("5012", , "Determinent equals zero, inverse can't be found !")

Error_Dimension:
        Err.Raise("5014", , "Matrix should be a square matrix !")

Error_Handler:
        If Err.Number = 5012 Then
            Err.Raise("5012", , "Determinent equals zero, inverse can't be found !")
        ElseIf Err.Number = 5014 Then
            Err.Raise("5014", , "Matrix should be a square matrix !")
        End If

    End Function

#End Region '逆矩阵

#Region "Multiply Vectors"
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Multiply two vectors, dimensions should be (3x1)
    ' Function returns the solution or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function MultiplyVectors(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim i, j, k As Double
        Dim sol(2, 0) As Double
        Dim Rows1, Cols1 As Integer
        Dim Rows2, Cols2 As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat1, Rows1, Cols1)
        Find_R_C(Mat2, Rows2, Cols2)

        If Rows1 <> 2 Or Cols1 <> 0 Then
            GoTo Error_Dimension
        End If

        If Rows2 <> 2 Or Cols2 <> 0 Then
            GoTo Error_Dimension
        End If

        i = Mat1(1, 0) * Mat2(2, 0) - Mat1(2, 0) * Mat2(1, 0)
        j = Mat1(2, 0) * Mat2(0, 0) - Mat1(0, 0) * Mat2(2, 0)
        k = Mat1(0, 0) * Mat2(1, 0) - Mat1(1, 0) * Mat2(0, 0)

        sol(0, 0) = i : sol(1, 0) = j : sol(2, 0) = k

        Return sol

Error_Dimension:
        Err.Raise("5016", , "Dimension should be (2 x 0) for both matrices in order to do cross multiplication !")

Error_Handler:

        If Err.Number = 5016 Then
            Err.Raise("5016", , "Dimension should be (2 x 0) for both matrices in order to do cross multiplication !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function

#End Region   '两个3X1矢量相乘

#Region "Magnitude of a Vector"

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Magnitude of a Vector, vector should be (3x1)
    ' Function returns the solution or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function VectorMagnitude(ByVal Mat(,) As Double) As Double

        Dim Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)

        If Rows <> 2 Or Cols <> 0 Then
            GoTo Error_Dimension
        End If

        Return Sqrt(Mat(0, 0) * Mat(0, 0) + Mat(1, 0) * Mat(1, 0) + Mat(2, 0) * Mat(2, 0))

Error_Dimension:
        Err.Raise("5018", , "Dimension of the matrix should be (2 x 0) in order to find the vector's norm !")

Error_Handler:
        If Err.Number = 5018 Then
            Err.Raise("5018", , "Dimension of the matrix should be (2 x 0) in order to find the vector's magnitude !")
        Else
            Err.Raise("5022", , "In order to do this operation values must be assigned to the matrix !!")
        End If

    End Function
#End Region '矢量的长度

#Region "Transpose of a Matrix"
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Transpose of a matrix
    ' Function returns the solution or errors
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function Transpose(ByVal Mat(,) As Double) As Double(,)
        Dim Tr_Mat(,) As Double
        Dim i, j, Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)

        ReDim Tr_Mat(Cols, Rows)

        For i = 0 To Cols
            For j = 0 To Rows
                Tr_Mat(j, i) = Mat(i, j)
            Next j
        Next i

        Return Tr_Mat

Error_Handler:
        Err.Raise("5028", , "In order to do this operation values must be assigned to the matrix !!")

    End Function
#End Region '转置(矩)阵

#Region "Multiply a matrix or a vector with a scalar quantity"

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Multiply a matrix or a vector with a scalar quantity
    ' Function returns the solution or errors
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function ScalarMultiply(ByVal Value As Double, ByVal Mat(,) As Double) As Double(,)
        Dim i, j, Rows, Cols As Integer
        Dim sol(,) As Double

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)
        ReDim sol(Rows, Cols)

        For i = 0 To Rows
            For j = 0 To Cols
                sol(i, j) = Mat(i, j) * Value
            Next j
        Next i

        Return (sol)

Error_Handler:
        Err.Raise("5022", , "Matrix was not assigned")
    End Function

#End Region '数乘矩阵

#Region "Divide a matrix or a vector with a scalar quantity"
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Divide matrix elements or a vector by a scalar quantity
    ' Function returns the solution or errors
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function ScalarDivide(ByVal Value As Double, ByVal Mat(,) As Double) As Double(,)
        Dim i, j, Rows, Cols As Integer
        Dim sol(,) As Double

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)
        ReDim sol(Rows, Cols)

        For i = 0 To Rows
            For j = 0 To Cols
                sol(i, j) = Mat(i, j) / Value
            Next j
        Next i

        Return sol

        Exit Function

Error_Handler:
        Err.Raise("5022", , "Matrix was not assigned")
    End Function

#End Region '矩阵除以常数

#Region "Print Matrix"

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Print a matrix to multitext text box
    ' Function returns the solution or errors
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function PrintMat(ByVal Mat(,) As Double) As String
        Dim N_Rows As Integer, N_Columns, k As Integer, _
            i As Integer, j As Integer, m As Integer
        Dim StrElem As String, StrLen As Long, _
            Greatest() As Integer, LarString As String
        Dim OptiString As String, sol As String

        Find_R_C(Mat, N_Rows, N_Columns)

        sol = ""
        OptiString = ""

        ReDim Greatest(N_Columns)

        For i = 0 To N_Rows
            For j = 0 To N_Columns
                If i = 0 Then
                    Greatest(j) = 0
                    For m = 0 To N_Rows
                        StrElem = Format$(Mat(m, j), "0.0000")
                        StrLen = Len(StrElem)
                        If Greatest(j) < StrLen Then
                            Greatest(j) = StrLen
                            LarString = StrElem
                        End If
                    Next m
                    If Mid$(LarString, 1, 1) = "-" Then Greatest(j) = Greatest(j) + 1
                End If
                StrElem = Format$(Mat(i, j), "0.0000")
                If Mid$(StrElem, 1, 1) = "-" Then
                    StrLen = Len(StrElem)
                    If Greatest(j) >= StrLen Then
                        For k = 1 To (Greatest(j) - StrLen)
                            OptiString = OptiString & " "
                        Next k
                        OptiString = OptiString & " "
                    End If
                Else
                    StrLen = Len(StrElem)
                    If Greatest(j) > StrLen Then
                        For k = 1 To (Greatest(j) - StrLen)
                            OptiString = OptiString & " "
                        Next k
                    End If
                End If
                OptiString = OptiString & " " & Format$(Mat(i, j), "0.0000")
            Next j
            If i <> N_Rows Then
                sol = sol & OptiString & vbCrLf
                OptiString = ""
            End If
            sol = sol & OptiString
            OptiString = ""
        Next i

        PrintMat = sol

        Exit Function
    End Function
#End Region '输出矩阵


End Class