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

适用于vb.net的矩阵运算

一个封装了常规的矩阵和向量计算的VB.Net类模块（cMatLib.vb），相当好，来源于一个相当好的外国源码提供的网站http://www.planet-source-code.com

Option Strict Off
Option Explicit On

Imports System.Math

Public Class MatLib
    Private Shared Sub Find_R_C(ByVal Mat(,) As Double, ByRef Row As Integer, ByRef Col As Integer)
        Row = Mat.GetUpperBound(0)
        Col = Mat.GetUpperBound(1)
    End Sub

#Region "Add Matrices"
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Add two matrices, their dimensions should be compatible!
    ' Function returns the summation or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function Add(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim sol(,) As Double
        Dim i, j As Integer
        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 <> Rows2 Or Cols1 <> Cols2 Then
            GoTo Error_Dimension
        End If

        ReDim sol(Rows1, Cols1)
        For i = 0 To Rows1
            For j = 0 To Cols1
                sol(i, j) = Mat1(i, j) + Mat2(i, j)
            Next j
        Next i

        Return sol

Error_Dimension:
        Err.Raise("5005", , "Dimensions of the two matrices do not match !")

Error_Handler:
        If Err.Number = 5005 Then
            Err.Raise("5005", , "Dimensions of the two matrices do not match !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function
#End Region    '矩阵相加

#Region "Subtract Matrices"
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Subtracts two matrices from each other, their
    ' dimensions should be compatible!
    ' Function returns the solution or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function Subtract(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim i, j As Integer
        Dim sol(,) 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 <> Rows2 Or Cols1 <> Cols2 Then
            GoTo Error_Dimension
        End If

        ReDim sol(Rows1, Cols1)

        For i = 0 To Rows1
            For j = 0 To Cols1
                sol(i, j) = Mat1(i, j) - Mat2(i, j)
            Next j
        Next i

        Return sol

Error_Dimension:
        Err.Raise("5007", , "Dimensions of the two matrices do not match !")

Error_Handler:
        If Err.Number = 5007 Then
            Err.Raise("5007", , "Dimensions of the two matrices do not match !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function

#End Region    '矩阵相减

#Region "Multiply Matrices"
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Multiply two matrices, their dimensions should be compatible!
    ' Function returns the solution or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function Multiply(ByVal Mat1(,) As Double, ByVal Mat2(,) As Double) As Double(,)
        Dim l, i, j As Integer
        Dim OptiString As String
        Dim sol(,) As Double, MulAdd As Double
        Dim Rows1, Cols1 As Integer
        Dim Rows2, Cols2 As Integer

        On Error GoTo Error_Handler

        MulAdd = 0

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

        If Cols1 <> Rows2 Then
            GoTo Error_Dimension
        End If

        ReDim sol(Rows1, Cols2)

        For i = 0 To Rows1
            For j = 0 To Cols2
                For l = 0 To Cols1
                    MulAdd = MulAdd + Mat1(i, l) * Mat2(l, j)
                Next l
                sol(i, j) = MulAdd
                MulAdd = 0
            Next j
        Next i

        Return sol

Error_Dimension:
        Err.Raise("5009", , "Dimensions of the two matrices not suitable for multiplication !")

Error_Handler:
        If Err.Number = 5009 Then
            Err.Raise("5009", , "Dimensions of the two matrices not suitable for multiplication !")
        Else
            Err.Raise("5022", , "One or both of the matrices are null, this operation cannot be done !!")
        End If

    End Function

#End Region     '矩阵相乘

#Region "Determinant of a Matrix"
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Determinant of a matrix should be (nxn)
    ' Function returns the solution or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function Det(ByVal Mat(,) As Double) As Double
        Dim DArray(,) As Double, S As Integer
        Dim k, k1, i, j As Integer
        Dim save, ArrayK As Double
        Dim M1 As String
        Dim Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)

        If Rows <> Cols Then GoTo Error_Dimension

        S = Rows
        Det = 1
        DArray = Mat.Clone()

        For k = 0 To S
            If DArray(k, k) = 0 Then
                j = k
                Do While ((j < S) And (DArray(k, j) = 0))
                    j = j + 1
                Loop
                If DArray(k, j) = 0 Then
                    Det = 0
                    Exit Function
                Else
                    For i = k To S
                        save = DArray(i, j)
                        DArray(i, j) = DArray(i, k)
                        DArray(i, k) = save
                    Next i
                End If

                Det = -Det
            End If
            ArrayK = DArray(k, k)
            Det = Det * ArrayK
            If k < S Then
                k1 = k + 1
                For i = k1 To S
                    For j = k1 To S
                        DArray(i, j) = DArray(i, j) - DArray(i, k) * (DArray(k, j) / ArrayK)
                    Next j
                Next i
            End If
        Next

        Exit Function

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

Error_Handler:
        If Err.Number = 5011 Then
            Err.Raise("5011", , "Matrix should be a square matrix !")
        Else
            Err.Raise("5022", , "In order to do this operation values must be assigned to the matrix !!")
        End If
    End Function

#End Region '矩阵的行列式

#Region "Inverse of a Matrix"
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Inverse of a matrix, should be (nxn) and det(Mat)<>0
    ' Function returns the solution or errors due to
    ' dimensions incompatibility
    ' Example:
    ' Check Main Form !!
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Shared Function Inv(ByVal Mat(,) As Double) As Double(,)
        Dim AI(,) As Double, AIN As Double, AF As Double, _
            Mat1(,) As Double
        Dim LL As Integer, LLM As Integer, L1 As Integer, _
            L2 As Integer, LC As Integer, LCA As Integer, _
            LCB As Integer, i As Integer, j As Integer
        Dim Rows, Cols As Integer

        On Error GoTo Error_Handler

        Find_R_C(Mat, Rows, Cols)
        If Rows <> Cols Then GoTo Error_Dimension

        If Det(Mat) = 0 Then GoTo Error_Zero

        LL = Rows
        LLM = Cols
        Mat1 = Mat.Clone()
        ReDim AI(LL, LL)

        For L2 = 0 To LL
            For L1 = 0 To LL
                AI(L1, L2) = 0
            Next
            AI(L2, L2) = 1
        Next

        For LC = 0 To LL
            If Abs(Mat1(LC, LC)) < 0.0000000001 Then
                For LCA = LC + 1 To LL
                    If LCA = LC Then GoTo 1090
                    If Abs(Mat1(LC, LCA)) > 0.0000000001 Then
                        For LCB = 0 To LL
                            Mat1(LCB, LC) = Mat1(LCB, LC) + Mat1(LCB, LCA)
                            AI(LCB, LC) = AI(LCB, LC) + AI(LCB, LCA)
                        Next
                        GoTo 1100
                    End If
1090:           Next
            End If

1100:
            AIN = 1 / Mat1(LC, LC)
            For LCA = 0 To LL
                Mat1(LCA, LC) = AIN * Mat1(LCA, LC)
                AI(LCA, LC) = AIN * AI(LCA, LC)