矩阵和向量计算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)
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