矩阵基本运算
最近看到不少矩阵运算的问题，本来MATLAB是最适合数值计算和分析的，向量运算不是VB6的长项，对于C也是这样。但应用中可能确实会有这种需求，加、减、乘等容易实现，用初等变换写了一个求逆的雏形，流程还是比较清晰。如果运行出错就是不满秩或矩阵不是方阵的情况，这个没有考虑。如感兴趣和有这类需求，可以完善和更改，有问题或建议欢迎指正和交流。
...
没有回复，可能是坛友们用不上，不感兴趣，但为了作为以后需要时的参考，还是增加了加、减、乘、转置功能，求逆做了部分完善。
模块
程序代码：Option Explicit
Type Matrix
element() As Single
err As Byte '非零为错误
End Type
'矩阵求逆
Function Inverse(a As Matrix) As Matrix
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim m As Integer
Dim h As Integer
Dim k As Single
Dim addition As Matrix '扩充矩阵
Dim AllZero As Boolean '某列是否全零
On Error GoTo warn
n = UBound(a.element, 1)
ReDim Inverse.element(1 To n, 1 To n)
ReDim addition.element(1 To n, 1 To 2 * n)
For i = 1 To n '初始化扩充矩阵
For j = 1 To n
addition.element(i, j) = a.element(i, j)
Next
Next
For i = 1 To n
For j = n + 1 To 2 * n
If j - i = n Then
addition.element(i, j) = 1
Else
addition.element(i, j) = 0
End If
Next
Next
With addition
For m = 2 To n '下三角
For i = n To m Step -1
'后续需要考虑保证.element(m-1,m-1)非0的代码处理
If .element(m - 1, m - 1) = 0 Then
AllZero = True
For h = m To n
If .element(h, m - 1) <> 0 Then AllZero = False: Exit For
Next
If AllZero = True Then GoTo warn '某列全零则矩阵不满秩，退出
For j = 1 To 2 * n
.element(m - 1, j) = .element(m - 1, j) + .element(h, j)
Next
End If
'以上为完善部分
If .element(i, m - 1) <> 0 Then
k = .element(m - 1, m - 1) / .element(i, m - 1)
For j = 1 To 2 * n
.element(i, j) = .element(i, j) * k - .element(m - 1, j)
Next
End If
Next
Next
For m = n - 1 To 1 Step -1 '上三角
For i = 1 To m
'后续需要考虑保证.element(m+1,m+1)非0的代码处理
'If .element(m + 1, m + 1) = 0 Then
' For h = m To 1 Step -1
' If .element(h, m + 1) <> 0 Then Exit For
' Next
' For j = 1 To 2 * n
' .element(m + 1, j) = .element(m + 1, j) + .element(h, j)
' Next
'End If
'以上为完善部分，未验证
'上三角完成后，下三角主对角元素不可能为零！
If .element(i, m + 1) <> 0 Then
k = .element(m + 1, m + 1) / .element(i, m + 1)
For j = 1 To 2 * n
.element(i, j) = .element(i, j) * k - .element(m + 1, j)
Next
End If
Next
Next
For i = 1 To n '主对角线元素置1
k = .element(i, i)
For j = 1 To 2 * n
.element(i, j) = .element(i, j) / k
Next
Next
For i = 1 To n '输出
For j = 1 To n
Inverse.element(i, j) = .element(i, j + n)
Next
Next
End With
Exit Function
warn:
Inverse.err = 1
End Function
'矩阵加减flag=0求和,flag=1求差
Function Add(a As Matrix, b As Matrix, flag As Byte) As Matrix
Dim i As Integer
Dim j As Integer
If flag <> 0 And flag <> 1 Then MsgBox ("Flag有误！"): Exit Function
If UBound(a.element, 1) <> UBound(b.element, 1) Or UBound(a.element, 2) <> UBound(b.element, 2) Then MsgBox ("输入矩阵有误！"): Exit Function
ReDim Add.element(1 To UBound(a.element, 1), 1 To UBound(a.element, 2))
For i = 1 To UBound(a.element, 1)
For j = 1 To UBound(a.element, 2)
Add.element(i, j) = a.element(i, j) + (1 - 2 * flag) * b.element(i, j)
Next
Next
End Function
'矩阵乘法
Function Multiply(a As Matrix, b As Matrix) As Matrix
Dim i As Integer
Dim j As Integer
Dim k As Integer
If UBound(a.element, 2) <> UBound(b.element, 1) Then Multiply.err = 2: Exit Function
ReDim Multiply.element(1 To UBound(a.element, 1), 1 To UBound(b.element, 2))
For i = 1 To UBound(a.element, 1)
For j = 1 To UBound(b.element, 2)
Multiply.element(i, j) = 0
For k = 1 To UBound(a.element, 2)
Multiply.element(i, j) = Multiply.element(i, j) + a.element(i, k) * b.element(k, j)
Next
Next
Next
End Function
'矩阵转置
Function Transpose(a As Matrix) As Matrix
Dim i As Integer
Dim j As Integer
ReDim Transpose.element(UBound(a.element, 2), UBound(a.element, 1))
For i = 1 To UBound(a.element, 1)
For j = 1 To UBound(a.element, 2)
Transpose.element(j, i) = a.element(i, j)
Next
Next
End Function
'在目标文本框中显示矩阵
Sub Display(a As Matrix, dest As TextBox)
Dim i As Integer
Dim j As Integer
dest.Text = dest.Text & "Matrix= " & vbCrLf
For i = 1 To UBound(a.element, 1)
For j = 1 To UBound(a.element, 2)
dest.Text = dest.Text & a.element(i, j) & vbTab
Next
dest.Text = dest.Text & vbCrLf
Next
dest.Text = dest.Text & vbCrLf
End Sub
测试窗体程序代码：Option Explicit
Dim x1 As Matrix '源矩阵
Dim x2 As Matrix
Dim y As Matrix '输出矩阵
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
y = Inverse(x2)
If y.err = 0 Then
Display y, Text1
Else
MsgBox ("Error " & y.err)
End If
End Sub
Private Sub Form_Load()
ReDim x1.element(1 To 3, 1 To 3)
ReDim x2.element(1 To 3, 1 To 3)
With x1
.element(1, 1) = 1
.element(1, 2) = 1
.element(1, 3) = -1
.element(2, 1) = 0
.element(2, 2) = 2
.element(2, 3) = 2
.element(3, 1) = 0
.element(3, 2) = -1
.element(3, 3) = 0
End With
With x2
.element(1, 1) = 0
.element(1, 2) = -1
.element(1, 3) = 1
.element(2, 1) = 0
.element(2, 2) = 0
.element(2, 3) = -1
.element(3, 1) = 1
.element(3, 2) = -1
.element(3, 3) = 1
End With
Display x1, Text1
Display x2, Text1
End Sub[ 本帖最后由 lianyicq 于 2015-7-7 11:22 编辑 ]
没有回复是不是表示没有需求？不知道结贴会怎么样。