📄 clsmatrix.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsMatrix"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Type Matrix
m As Integer 'm为矩阵的行
n As Integer 'n为矩阵的列
Element() As Double '2D array of elements
End Type
Private Function CreateMatrix(ByVal m As Integer, ByVal n As Integer, ParamArray Values() As Variant) As Matrix
' #Rows, #Cols [, R1C1, R1C2, R1C3... R1Cn, R2C1, R2C2, R2C3 .... RmCn]
' 创建一个m行、n列的矩阵;格式如下
' [ R1C1 R1C2 R1C3 ... R1Cn ]
' [ R2C1 R2C2 R2C3 ... R2Cn ]
' [ R3C1 R3C2 R3C3 ... R3Cn ]
' ... ... ... ... ...
' [ RmC1 RmC2 RmC3 ... RmCn ]
Dim i As Integer, j As Integer, k As Integer
Dim Temp As Matrix
Select Case True
Case m = 0, n = 0
MsgBox "不能创建一个零维矩阵", , "矩阵操作 - 创建矩阵"
Exit Function
End Select
With Temp
ReDim .Element(1 To m, 1 To n) ' 分配内存存储矩阵
.m = m ' 设定矩阵的维数
.n = n
'如果存在数据，则将数据填充到矩阵中
If UBound(Values) > 0 Then
For i = 1 To m
For j = 1 To n
' 如果下标越界，则跳出for循环
If k > UBound(Values) Then Exit For
.Element(i, j) = Values(k) ' 存储数据在矩阵中
k = k + 1 ' 下一矩阵元素
Next j
' 如果下标越界，则跳出for循环
If k > UBound(Values) Then Exit For
Next i
End If
End With
CreateMatrix = Temp ' 返回创建的矩阵
End Function
Private Function TransposeMatrix(ByRef dMat As Matrix) As Matrix
'矩阵转置，形式如下：
' [ R1C1 R1C2 R1C3 ... R1Cn ] [ R1C1 R2C1 R3C1 ... RmC1 ]
' [ R2C1 R2C2 R2C3 ... R2Cn ] [ R1C2 R2C2 R3C2 ... RmC2 ]
' [ R3C1 R3C2 R3C3 ... R3Cn ] => [ R1C3 R2C3 R3C3 ... RmC3 ]
' ... ... ... ... ... ... ... ... ... ...
' [ RmC1 RmC2 RmC3 ... RmCn ] [ R1Cn R2Cn R3Cn ... RmCn ]
Dim i As Integer, j As Integer
Dim Temp As Matrix
With dMat
' 创建一临时矩阵
Temp.m = .n '设置临时矩阵的维数与给出的矩阵相反的维数r
Temp.n = .m '也即临时矩阵的行等于已知矩阵的列，临时矩阵的列等于已知矩阵的行
For i = 1 To .m ' 行、列值互换
For j = 1 To .n
Temp.Element(j, i) = .Element(i, j)
Next j
Next i
End With
TransposeMatrix = Temp
End Function
Private Function ScaleMatrix(ByRef dMat As Matrix, ByVal Multiplier As Double) As Matrix
' 矩阵与常数相乘，例如：
' [ a b ] [ 2a 2b ]
' 2 [ c d ] => [ 2c 2d ]
' [ e f ] [ 2e 2f ]
Dim i As Integer, j As Integer
Dim Temp As Matrix
Temp = dMat
With Temp
For i = 1 To .m
For j = 1 To .n
.Element(i, j) = .Element(i, j) * Multiplier
Next j
Next i
End With
ScaleMatrix = Temp
End Function
Private Function AddMatrix(ByRef dMat1 As Matrix, ByRef dMat2 As Matrix) As Matrix
' 两个同维数的矩阵相加，例如：
' [ a b ] [ u v ] [ a+u b+v ]
' [ c d ] + [ w x ] => [ c+w d+x ]
' [ e f ] [ y z ] [ e+y f+z ]
' 注意：两相加矩阵必须具体相同的维数，否则函数将提示出错
'
Dim i As Integer, j As Integer
Dim Temp As Matrix
i = dMat1.m
j = dMat1.n
'检查矩阵是否同维数
Select Case False
Case i = dMat2.m, j = dMat2.n
MsgBox "两不同维数的矩阵不能相加", , "矩阵操作 - 矩阵相加"
Exit Function
End Select
Temp = CreateMatrix(i, j)
With Temp
For i = 1 To .m
For j = 1 To .n
.Element(i, j) = dMat1.Element(i, j) + dMat2.Element(i, j)
Next j
Next i
End With
AddMatrix = Temp
End Function
Private Function SubMatrix(ByRef dMat1 As Matrix, ByRef dMat2 As Matrix) As Matrix
'两个同维数的矩阵相减，见矩阵相加
Dim i As Integer, j As Integer
Dim Temp As Matrix
i = dMat1.m
j = dMat1.n
'检查矩阵是否同维数
Select Case False
Case i = dMat2.m, j = dMat2.n
MsgBox "两不同维数的矩阵不能相减", , "矩阵操作 - 矩阵相减"
Exit Function
End Select
Temp = CreateMatrix(i, j)
With Temp
For i = 1 To .m
For j = 1 To .n
.Element(i, j) = dMat1.Element(i, j) - dMat2.Element(i, j)
Next j
Next i
End With
SubMatrix = Temp
End Function
Private Function MultiplyMatrix(ByRef dMat1 As Matrix, ByRef dMat2 As Matrix) As Matrix
' 两个矩阵相乘，条件是左矩阵的列数等于右矩阵的行数，例如：
' [ a b c ] [ u v ] [ (au+bw+cy) (av+bx+cz) ]
' [ d e f ] * [ w x ] = > [ (du+ew+fy) (dv+ex+fz) ]
' [ y z ]
' 注意：因为矩阵值使用了双精度、浮点型
' 如果含有一个值为:如 2.22044E-16 或者0.00000000000000022044
' 其实这个值就是零
Dim i As Integer, j As Integer, k As Integer
Dim Tot As Double
Dim Temp As Matrix
i = dMat1.n
j = dMat2.m
If i <> j Then
MsgBox "左矩阵的列数不等于右矩阵的行数，两矩阵不能相乘", , "矩阵操作 - 矩阵相乘"
Exit Function
End If
Temp = CreateMatrix(dMat1.m, dMat2.n)
With dMat1
For k = 1 To dMat2.n ' 对右矩阵的每行进行操作
For i = 1 To .m ' 对左矩阵的每行进行操作
Tot = 0 ' 重置累加值为0
For j = 1 To .n ' 对左矩阵的每列进行操作
' 把对应的元素值相乘并累加在一块
Tot = Tot + .Element(i, j) * dMat2.Element(j, k)
Next j
' 存储累加值
Temp.Element(i, k) = Tot
Next i
Next k
End With
MultiplyMatrix = Temp
End Function
Private Function Determinant(ByRef dMat As Matrix) As Double
' 计算矩阵的行列式，要求矩阵为方阵,也即矩阵的m=n，例如：
' | |
' | [ a b ] | => (a*d)-(b*c)
' | [ c d ] |
' | |
'
' 对于大矩阵而言，先t将其化为上三角形式，上三角形式如下：
' [ R11 R12 R13 ... R1n ] [ R11' R12' R13' ... R1n' ]
' [ R21 R22 R23 ... R2n ] [ 0 R22' R23' ... R2n' ]
' [ R31 R32 R33 ... R3n ] => [ 0 0 R33' ... R3n' ]
' ... ... ... ... ... ... ... ... ... ...
' [ Rm1 Rm2 Rm3 ... Rmn ] [ 0 0 0 ... Rmn' ]
' 矩阵的行列式即为上三角矩阵的对角线各元素值的乘数
Dim i As Integer, j As Integer
Dim m As Integer, n As Integer
Dim a1 As Double, b1 As Double
Dim a2 As Double, b2 As Double
Dim Mult As Double
Dim Det As Double
Dim Temp As Matrix
Dim x As Integer, y As Integer
With dMat
i = .m
j = .n
'检查矩阵是否为方阵
Select Case True
Case i <> j
MsgBox "矩阵不为方阵，不能求行列式", , "矩阵操作 - 矩阵行列式计算"
Exit Function
Case i = 0
MsgBox "不能对零维矩阵求行列式", , "矩阵操作 - 矩阵行列式计算"
Exit Function
End Select
Select Case j
Case 1
'一维矩阵的行列式计算
Det = .Element(1, 1)
Case 2
'二维方阵的行列式计算
Det = (.Element(1, 1) * .Element(2, 2)) - (.Element(1, 2) * .Element(2, 1))
Case Else
'大于等于三维的方阵的行列式计算
Temp = dMat
Det = 1
'对方阵进行高斯-约化
For i = 1 To j
For m = i + 1 To j
If Temp.Element(i, i) = 0 Then
Determinant = 0 '秩亏方阵
Exit Function
Else
If Temp.Element(m, m) - Temp.Element(m, i) / Temp.Element(i, i) * Temp.Element(i, m) = 0 Then
For y = 1 To j
If Not Temp.Element(y, i) = 0 Then
For x = 1 To j
Temp.Element(m, x) = Temp.Element(m, x) + Temp.Element(m + 1, x)
Next x
End If
Next y
End If
Mult = Temp.Element(m, i) / Temp.Element(i, i)
End If
For n = i To j '调整元素的列
Temp.Element(m, n) = Temp.Element(m, n) - (Mult * Temp.Element(i, n))
Next n
Next m
'将上三角矩阵的各对角线元素相乘得出方阵的行列式
Det = Det * Temp.Element(i, i)
Next i
End Select
End With
Determinant = Det
End Function
Private Function InvertMatrix(ByRef dMat As Matrix) As Matrix
' 求矩阵的逆，矩阵必须为方阵，行列式为0没有逆矩阵
'矩阵的逆定义为一矩阵与其逆矩阵相乘所得矩阵为单位矩阵，形如：
' [ a b c ] [ a b c ]-1 [ 1 0 0 ]
' [ d e f ] * [ d e f ] => [ 0 1 0 ]
' [ g h i ] [ g h i ] [ 0 0 1 ]
Dim i As Integer, j As Integer
Dim x As Integer, y As Integer
Dim size As Integer, Sine As Integer
Dim Temp As Matrix, sMat As Matrix
Dim Det As Double
With dMat
i = .n
j = .m
size = j
Select Case True
Case i <> j
MsgBox "矩阵不为方阵，不能求行列式", , "矩阵操作 - 矩阵求逆"
Exit Function
Case i = 1
InvertMatrix = CreateMatrix(1, 1, 1 / .Element(1, 1))
End Select
Det = Determinant(dMat)
Select Case True
Case Det = 0
MsgBox "不能对零维矩阵求行列式", , "矩阵操作 - 矩阵行列式计算"
Exit Function
Case i = 2
' 直接计算二维矩阵的逆矩阵
Temp = CreateMatrix(2, 2, .Element(2, 2), -.Element(1, 2), -.Element(2, 1), .Element(1, 1))
InvertMatrix = ScaleMatrix(Temp, 1 / Det)
Exit Function
End Select
Temp = CreateMatrix(size, size)
For i = 1 To size
For j = 1 To size
sMat = SubMat(dMat, i, j)
Sine = (-1) ^ (i + j)
Temp.Element(i, j) = Determinant(sMat) * Sine
Next j
Next i
End With
Temp = TransposeMatrix(Temp) '将C矩阵转置
InvertMatrix = ScaleMatrix(Temp, 1 / Det) '将C矩阵除以行列式
End Function
Private Function InsertMatrix(ByRef dMatDest As Matrix, ByRef dMatSrc As Matrix, ByVal mPos As Integer, ByVal nPos As Integer) As Matrix
' 插入一个子矩阵到一个大矩阵当中，重新排列矩阵元素，插入形式如下：
' [ a b c ] [ a b c ]
' [ d e f ] <- [ w x ] = [ d w x ]
' [ g h i ] [ y z ] [ g y z ]
' mPos和nPos是子矩阵拟插入到源矩阵中的行数和列数
Dim i As Integer, j As Integer
Dim MaxRow As Integer, MaxCol As Integer
Dim Temp As Matrix
Temp = dMatDest
With dMatSrc
i = Temp.m
j = Temp.n
'替换操作
MaxRow = IIf(.m >= i, i - .m + 1, IIf(.m < i, .m, i))
MaxCol = IIf(.n >= j, j - .n + 1, IIf(.n < j, .n, j))
mPos = mPos - 1
nPos = nPos - 1
For i = 1 To MaxRow ' 将各元素写入矩阵中
For j = 1 To MaxCol
Temp.Element(i + mPos, j + nPos) = .Element(i, j)
Next j
Next i
End With
InsertMatrix = Temp
End Function
Private Sub Class_Initialize()
Dim Temp As Matrix
Temp.m = 1
Temp.n = 1
ReDim Element(1 To 1)
Element(1) = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -