Использования файлов для работы с матрицами - VB

Узнай цену своей работы

Формулировка задачи:

Даны два файла вещественных чисел с именами Sa и Sb, содержащие элементы прямоугольной матрицы А и В (по строкам) , причем первый элемент каждого файла содержит количество столбцов соответствующей матрицы. Создать фаил той же структуры с именем Sc, содержащий элементы произведения А*В. Если матрицы А*В нельзя перемножить то оставить файл Sc пустым???

Решение задачи: «Использования файлов для работы с матрицами»

textual
Листинг программы
  1. Private Sub cmdCreateMatrix_Click()  ' Создаем матрицы
  2.    Dim Sa() As Double, Sb() As Double
  3.     CreateRandomMatrix Sa, Int(Rnd * 5) + 2, Int(Rnd * 5) + 2
  4.     CreateRandomMatrix Sb, Int(Rnd * 5) + 2, Int(Rnd * 5) + 2
  5.     SaveMatrixToFile Sa, App.Path & "\Sa"
  6.     SaveMatrixToFile Sb, App.Path & "\Sb"
  7.     txtLog.Text = "Созданные матрицы: " & vbNewLine
  8.     PrintMatrix Sa, "Sa"
  9.     PrintMatrix Sb, "Sb"
  10. End Sub
  11. Private Sub cmdMulMatrix_Click()    ' Перемножаем
  12.    Dim Sa() As Double, Sb() As Double, Sc() As Double
  13.     If Not LoadMatrixFromFile(Sa, App.Path & "\Sa") Then MsgBox ("Ошибка открытия файла"): Exit Sub
  14.     If Not LoadMatrixFromFile(Sb, App.Path & "\Sb") Then MsgBox ("Ошибка открытия файла"): Exit Sub
  15.     txtLog.Text = "Загрузка и перемножение: " & vbNewLine
  16.     PrintMatrix Sa, "Sa"
  17.     PrintMatrix Sb, "Sb"
  18.     If MulMatrix(Sa, Sb, Sc) Then SaveMatrixToFile Sc, App.Path & "\Sc" Else MsgBox ("Матрицы нельзя умножить"): Exit Sub
  19.     PrintMatrix Sc, "Sc"
  20. End Sub
  21. Private Function MulMatrix(Mtrx1() As Double, Mtrx2() As Double, MtrxOut() As Double) As Boolean 'Функция умножения двух матриц
  22.    If UBound(Mtrx1, 2) <> UBound(Mtrx2, 1) Then Exit Function
  23.     ReDim MtrxOut(UBound(Mtrx1, 1), UBound(Mtrx2, 2))
  24.     For i = 0 To UBound(Mtrx1, 1): For j = 0 To UBound(Mtrx2, 2): MtrxOut(i, j) = 0
  25.         For k = 0 To UBound(Mtrx1, 2)
  26.             MtrxOut(i, j) = MtrxOut(i, j) + Mtrx2(k, j) * Mtrx1(i, k)
  27.         Next
  28.     Next: Next
  29.     MulMatrix = True
  30. End Function
  31. Private Function PrintMatrix(Mtx() As Double, Name As String) ' Отображаем матрицу
  32.    Dim i As Long, j As Long, q As String
  33.     txtLog.Text = txtLog.Text & Name & " {" & vbNewLine
  34.     For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
  35.         q = Space(5)
  36.         LSet q = Str$(Mtx(i, j))
  37.         txtLog.Text = txtLog.Text & q & "  "
  38.     Next
  39.     txtLog.Text = txtLog.Text & vbNewLine
  40.     Next
  41.     txtLog.Text = txtLog.Text & "}" & vbNewLine
  42. End Function
  43. Private Function LoadMatrixFromFile(Mtx() As Double, Path As String) As Boolean ' Процедура, загружающая матрицу из файла
  44.    Dim fNum As Integer, D As Long, L As Long
  45.     Dim i As Long, j As Long
  46.     If Dir$(Path) = vbNullString Then Exit Function 'Если файла не существует то выходим
  47.    fNum = FreeFile
  48.     Open Path For Binary As fNum
  49.     Get fNum, , D
  50.     If D <= 0 Or D > 7 Then Exit Function    ' Если количество столбцов некорректно, то выходим
  51.    L = Int(CSng((LOF(fNum) - 4) / 8) / D + 0.5) ' Определяем количество строк
  52.    ReDim Mtx(D - 1, L - 1)
  53.     For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
  54.         Get fNum, , Mtx(i, j)
  55.     Next: Next
  56.     Close fNum
  57.     LoadMatrixFromFile = True
  58. End Function
  59. Private Sub SaveMatrixToFile(Mtx() As Double, Path As String) 'Процедура, сохраняющая матрицу в файл
  60.    Dim fNum As Integer
  61.     Dim i As Long, j As Long
  62.     If Not Dir$(Path) = vbNullString Then Kill Path
  63.     fNum = FreeFile
  64.     Open Path For Binary As fNum
  65.     ' Записываем число столбцов
  66.    Put fNum, , CLng(UBound(Mtx, 1) + 1)
  67.     ' Записываем данные по строкам
  68.    For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
  69.         Put fNum, , Mtx(i, j)
  70.     Next: Next
  71.     Close fNum
  72. End Sub
  73. Private Sub CreateRandomMatrix(Mtx() As Double, ByVal Col As Long, ByVal Row As Long) 'Процедура, создающая произвольную матрицу
  74.    Dim i As Long, j As Long
  75.     ReDim Mtx(Col - 1, Row - 1)
  76.     For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
  77.         Mtx(i, j) = Int(Rnd * 10)
  78.     Next: Next
  79. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.071 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы