Использования файлов для работы с матрицами - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д