Использования файлов для работы с матрицами - VB
Формулировка задачи:
Даны два файла вещественных чисел с именами Sa и Sb, содержащие элементы прямоугольной матрицы А и В (по строкам) , причем первый элемент каждого файла содержит количество столбцов соответствующей матрицы. Создать фаил той же структуры с именем Sc, содержащий элементы произведения А*В. Если матрицы А*В нельзя перемножить то оставить файл Sc пустым???
Решение задачи: «Использования файлов для работы с матрицами»
textual
Листинг программы
Private Sub cmdCreateMatrix_Click() ' Создаем матрицы
Dim Sa() As Double, Sb() As Double
CreateRandomMatrix Sa, Int(Rnd * 5) + 2, Int(Rnd * 5) + 2
CreateRandomMatrix Sb, Int(Rnd * 5) + 2, Int(Rnd * 5) + 2
SaveMatrixToFile Sa, App.Path & "\Sa"
SaveMatrixToFile Sb, App.Path & "\Sb"
txtLog.Text = "Созданные матрицы: " & vbNewLine
PrintMatrix Sa, "Sa"
PrintMatrix Sb, "Sb"
End Sub
Private Sub cmdMulMatrix_Click() ' Перемножаем
Dim Sa() As Double, Sb() As Double, Sc() As Double
If Not LoadMatrixFromFile(Sa, App.Path & "\Sa") Then MsgBox ("Ошибка открытия файла"): Exit Sub
If Not LoadMatrixFromFile(Sb, App.Path & "\Sb") Then MsgBox ("Ошибка открытия файла"): Exit Sub
txtLog.Text = "Загрузка и перемножение: " & vbNewLine
PrintMatrix Sa, "Sa"
PrintMatrix Sb, "Sb"
If MulMatrix(Sa, Sb, Sc) Then SaveMatrixToFile Sc, App.Path & "\Sc" Else MsgBox ("Матрицы нельзя умножить"): Exit Sub
PrintMatrix Sc, "Sc"
End Sub
Private Function MulMatrix(Mtrx1() As Double, Mtrx2() As Double, MtrxOut() As Double) As Boolean 'Функция умножения двух матриц
If UBound(Mtrx1, 2) <> UBound(Mtrx2, 1) Then Exit Function
ReDim MtrxOut(UBound(Mtrx1, 1), UBound(Mtrx2, 2))
For i = 0 To UBound(Mtrx1, 1): For j = 0 To UBound(Mtrx2, 2): MtrxOut(i, j) = 0
For k = 0 To UBound(Mtrx1, 2)
MtrxOut(i, j) = MtrxOut(i, j) + Mtrx2(k, j) * Mtrx1(i, k)
Next
Next: Next
MulMatrix = True
End Function
Private Function PrintMatrix(Mtx() As Double, Name As String) ' Отображаем матрицу
Dim i As Long, j As Long, q As String
txtLog.Text = txtLog.Text & Name & " {" & vbNewLine
For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
q = Space(5)
LSet q = Str$(Mtx(i, j))
txtLog.Text = txtLog.Text & q & " "
Next
txtLog.Text = txtLog.Text & vbNewLine
Next
txtLog.Text = txtLog.Text & "}" & vbNewLine
End Function
Private Function LoadMatrixFromFile(Mtx() As Double, Path As String) As Boolean ' Процедура, загружающая матрицу из файла
Dim fNum As Integer, D As Long, L As Long
Dim i As Long, j As Long
If Dir$(Path) = vbNullString Then Exit Function 'Если файла не существует то выходим
fNum = FreeFile
Open Path For Binary As fNum
Get fNum, , D
If D <= 0 Or D > 7 Then Exit Function ' Если количество столбцов некорректно, то выходим
L = Int(CSng((LOF(fNum) - 4) / 8) / D + 0.5) ' Определяем количество строк
ReDim Mtx(D - 1, L - 1)
For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
Get fNum, , Mtx(i, j)
Next: Next
Close fNum
LoadMatrixFromFile = True
End Function
Private Sub SaveMatrixToFile(Mtx() As Double, Path As String) 'Процедура, сохраняющая матрицу в файл
Dim fNum As Integer
Dim i As Long, j As Long
If Not Dir$(Path) = vbNullString Then Kill Path
fNum = FreeFile
Open Path For Binary As fNum
' Записываем число столбцов
Put fNum, , CLng(UBound(Mtx, 1) + 1)
' Записываем данные по строкам
For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
Put fNum, , Mtx(i, j)
Next: Next
Close fNum
End Sub
Private Sub CreateRandomMatrix(Mtx() As Double, ByVal Col As Long, ByVal Row As Long) 'Процедура, создающая произвольную матрицу
Dim i As Long, j As Long
ReDim Mtx(Col - 1, Row - 1)
For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
Mtx(i, j) = Int(Rnd * 10)
Next: Next
End Sub