矩阵相乘和矩阵求逆(已调试)
102901200805002380
' 模块名：MatrixModule.bas
' 函数名：MMul
' 功能： 计算矩阵的乘法
' 参数： m - Integer型变量，相乘的左边矩阵的行数
' n - Integer型变量，相乘的左边矩阵的列数和右边矩阵的行数
' l - Integer型变量，相乘的右边矩阵的列数
' mtxA - Double型m x n二维数组，存放相乘的左边矩阵
' mtxB - Double型n x l二维数组，存放相乘的右边矩阵
' mtxC - Double型m x l二维数组，返回矩阵乘积矩阵
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MMul(m As Integer, n As Integer, l As Integer, mtxA() As Double, mtxB() As Double, mtxC() As Double)
Dim i As Integer, j As Integer, k As Integer
For i = 1 To m
For j = 1 To l
mtxC(i, j) = 0#
For k = 1 To n
mtxC(i, j) = mtxC(i, j) + mtxA(i, k) * mtxB(k, j)
Next k
Next j
Next i
End Sub
=================================================================================
矩阵求逆
Private Function MRinv(N As Integer, mtxA() As Double) As Boolean
'****************************************************************************************
' 功能： 实现矩阵求逆的全选主元高斯－约当法
' 参数： n - Integer型变量，矩阵的阶数
' mtxA - Double型二维数组，体积为n x n。存放原矩阵A；返回时存放其逆矩阵A-1。
' 返回值：Boolean型，失败为False，成功为True
'****************************************************************************************
ReDim nIs(N) As Integer, nJs(N) As Integer
Dim i As Integer, j As Integer, k As Integer
Dim D As Double, p As Double
' 全选主元，消元
For k = 1 To N
D = 0#
For i = k To N
For j = k To N
p = Abs(mtxA(i, j))
If (p > D) Then
D = p
nIs(k) = i
nJs(k) = j
End If
Next j
Next i
' 求解失败
If (D + 1# = 1#) Then
MRinv = False
Exit Function
End If
If (nIs(k) <> k) Then
For j = 1 To N
p = mtxA(k, j)
mtxA(k, j) = mtxA(nIs(k), j)
mtxA(nIs(k), j) = p
Next j
En
d If
If (nJs(k) <> k) Then
For i = 1 To N
p = mtxA(i, k)
mtxA(i, k) = mtxA(i, nJs(k))
mtxA(i, nJs(k)) = p
Next i
End If
mtxA(k, k) = 1# / mtxA(k, k)
For j = 1 To N
If (j <> k) Then mtxA(k, j) = mtxA(k, j) * mtxA(k, k)
Next j
For i = 1 To N
If (i <> k) Then
For j = 1 To N
If (j <> k) Then mtxA(i, j) = mtxA(i, j) - mtxA(i, k) * mtxA(k, j)
Next j
End If
Next i
For i = 1 To N
If (i <> k) Then mtxA(i, k) = -mtxA(i, k) * mtxA(k, k)
Next i
Next k
' 调整恢复行列次序
For k = N To 1 Step -1
If (nJs(k) <> k) Then
For j = 1 To N
p = mtxA(k, j)
mtxA(k, j) = mtxA(nJs(k), j)
mtxA(nJs(k), j) = p
Next j
End If
If (nIs(k) <> k) Then
For i = 1 To N
p = mtxA(i, k)
mtxA(i, k) = mtxA(i, nIs(k))
mtxA(i, nIs(k)) = p
Next i
End If
Next k
' 求解成功
MRinv = True
End Function
===========================================================================================
======================================================================================
Public Sub jzqn(qa(), na())
Dim a()
n = UBound(qa, 1)
ReDim na(n, n)
ReDim a(n, 2 * n)
For i = 1 To n
For j = 1 To n
a(i, j) = qa(i, j)
Next j
Next i
For i = 1 To n
For j = n + 1 To 2 * n
If j - i = n Then
a(i, j) = 1
Else
a(i, j) = 0
End If
Next j
Next i
For i = 1 To n
If a(i, i) = 0 Then
For q = i To n
If a(q, i) <> 0 Then
For w = i To 2 * n
zj = a(i, w)
a(i, w) = a(q, w)
a(q, w) = zj
Next w
Exit For
End If
Next q
If q > n Then MsgBox "此矩阵不可逆": Exit Sub
End If
For k = 2 * n To i Step -1
a(i, k) = a(i, k) / a(i, i)
Next k
For j = i + 1 To n
If a(j, i) <> 0 Then
For k = 2 * n To i Step -1
a(j, k) = a(j, k) / a(j, i) - a(i, k)
Next k
End If
Next j
Next i
For i = n To 1 Step -1
If a(i, i) = 0 Then
For q = i - 1 To 1 Step -1
If a(q, i) <> 0 Then
For w = i To 2 * n
zj = a(i, w)
a(i, w) = a(q, w)
a(q, w) = zj
Next w
Exit For
End If
Next q
End If
For k = 2 * n To i Step -1
a(i, k) = a(i, k) / a(i, i)
Next k
For j = i - 1 To 1 Step -1
If a(j, i) <> 0 Then
xxx = a(j, i)
For k = 2 * n To 1 Step -1
a(j, k) = a(j, k) / xxx - a(i, k)
Next k
End If
Next j
Next i
For i = 1 To n
For j = 1 To n
na(i, j) = a(i, j + n)
Next j
Next i
End Sub
调用示例：下面代码随机产生一个10*10的矩阵，并求逆，打印于窗体
Private Sub Command1_Click()
Dim a(10, 10), b()
Cls
Randomize
For i = 1 To 10
For j = 1 To 10
a(i, j) = Int(Rnd * 100)
Print a(i, j);
Next j
Print
Next i
Print
Call jzqn(a(), b())
For i = 1 To 10
For j = 1 To 10
Print Format(b(i, j), "0.000"),
Next j
Print
Next i
End Sub