Программа


DECLARE SUB GetMatrix (Head$, A!())
DECLARE SUB OutMatrix (Head$, A!())
DECLARE SUB GetInvMatrix (Matrix!(), InvMatrix!())
DECLARE SUB MultiplyMatrix (A!(), B!(), C!())
DECLARE FUNCTION GetAlgebraicAdd! (Matrix!(), Lne!, Col!)
DECLARE FUNCTION GetMinor! (Matrix!(), Lne!, Col!)
DECLARE FUNCTION GetDet! (B!())
DECLARE SUB SwapLn (A!(), Ln1!, Ln2!)
INPUT "Введите размерность матрицы "; Dimension  'Ввод размерности матрицы
DIM Matrix(1 TO Dimension, 1 TO Dimension) 'Массив матрицы
DIM Matrix2(1 + 1 TO Dimension + 1, 1 - 10 TO Dimension - 10)'Массив матрицы
DIM Matrix3(1 - 1 TO Dimension - 1, 1 + 3 TO Dimension + 3)'Массив матрицы
CALL GetMatrix("Matrix", Matrix()) 'Ввод матрицы
CALL OutMatrix("Матрица", Matrix()) 'Вывод матрицы
PRINT "Det="; GetDet(Matrix())
CALL GetInvMatrix(Matrix(), Matrix2()) 'Получение обратной матрицы
CALL OutMatrix("Обратная матрица", Matrix2()) 'Вывод матрицы
PRINT "Det="; GetDet(Matrix2())
CALL MultiplyMatrix(Matrix(), Matrix2(), Matrix3())
CALL OutMatrix("Произведение ", Matrix3())

FUNCTION GetAlgebraicAdd (Matrix(), Lne, Col)
                                 'Функция получения алгебраического дополнения
  GetAlgebraicAdd = (-1) ^ (Lne + Col) * GetMinor(Matrix(), Lne - 1 + LBOUND(Matrix, 1), Col - 1 + LBOUND(Matrix, 2))
END FUNCTION

FUNCTION GetDet (B())  'Функция вычисления определителя
  'Определение рабочего массива:
  DIM A(LBOUND(B, 1) TO UBOUND(B, 1), LBOUND(B, 2) TO UBOUND(B, 2))
  FOR i = LBOUND(B, 1) TO UBOUND(B, 1) 'Цикл копирования строк
    FOR j = LBOUND(B, 2) TO UBOUND(B, 2) 'Цикл коаирования строки
      A(i, j) = B(i, j) 'Копирование элемента
    NEXT j
  NEXT i
  Det = 1 'Начальное определение произведения диагональных элементов
  FOR i = LBOUND(A, 2) TO UBOUND(A, 2) - 1 'Цикл прохода по столбцам
                 ' с приведением матрицы к верхнетреугольному виду
    j = i - LBOUND(A, 2) + LBOUND(A, 1)
                            'Вычисление идекса строки диагонального элемента
    'Поиск строки с ненулевым поддиагональным элементом
    '(если диагональный элемент нулевой):
    WHILE (A(j, i) = 0) AND (j < UBOUND(A, 1))
      j = j + 1
    WEND
    IF i - LBOUND(A, 2) + LBOUND(A, 1) <> j THEN Det = -Det
                    'Учет влияния перестановки строк матрицы на определитель
    CALL SwapLn(A(), i - LBOUND(A, 2) + LBOUND(A, 1), j) 'Перестановка строк матрицы
    IF A(i - LBOUND(A, 2) + LBOUND(A, 1), i) = 0 THEN
      'Определение значения функции и выход при отсутствии ненулевых элементов
      'под диагональным элементом (если диагональный элемент нулевой)
      GetDet = 0
      GOTO EndFunction
    END IF
    FOR j = i - LBOUND(A, 2) + LBOUND(A, 1) + 1 TO UBOUND(A, 1) 'Цикл пересчета строк
      Koef = A(j, i) / A(i - LBOUND(A, 2) + LBOUND(A, 1), i) 'Расчет множителя
      FOR k = i TO UBOUND(A, 2) 'Цикл пересчета элементов строки
        A(j, k) = A(j, k) - A(i - LBOUND(A, 2) + LBOUND(A, 1), k) * Koef
      NEXT k
    NEXT j
  NEXT i
  FOR i = LBOUND(A, 1) TO UBOUND(A, 1)  'Цикл прохода по диагонали
    Det = Det * A(i, i - LBOUND(A, 1) + LBOUND(A, 2))'Набор произведения диагональных элементов
  NEXT i
  GetDet = Det 'Определение значения функции
EndFunction:
END FUNCTION

SUB GetInvMatrix (M(), IM()) 'Процедура вычисления обратной матрицы
  DetMatrix = GetDet(M()) 'Вычисление определителя
    'Цикл расчета элементов обратной матрицы:
    FOR i = LBOUND(M, 1) TO UBOUND(M, 1)
      FOR j = LBOUND(M, 2) TO UBOUND(M, 2)
        IM(j - LBOUND(M, 2) + LBOUND(IM, 1), i - LBOUND(M, 1) + LBOUND(IM, 2)) = GetAlgebraicAdd(M(), i + 1 - LBOUND(M, 1), j + 1 - LBOUND(M, 2)) / DetMatrix
      NEXT j
    NEXT i
END SUB

SUB GetMatrix (Head$, A()) 'Процедура задания матрицы
  FOR i% = LBOUND(A, 1) TO UBOUND(A, 1) 'Цикл ввода строк
    FOR j% = LBOUND(A, 2) TO UBOUND(A, 2) 'Цикл ввода строки
      'PRINT USING "Введите элемент &[#_,#] "; Head$; i%; j%; 'Вывод приглашения
      'INPUT A(i%, j%) 'Ввод элемента
      A(i%, j%) = RND
    NEXT j%
  NEXT i%
END SUB

FUNCTION GetMinor (Matrix(), Lne, Col) 'Функция вычисления минора матрицы
  IF UBOUND(Matrix, 1) - LBOUND(Matrix, 1) = 0 THEN
    GetMinor = 1 'Условное "определение" минора для матриц 1x1
  ELSE
    'Определение массива под "минор"
    DIM Minor(LBOUND(Matrix, 1) TO UBOUND(Matrix, 1) - 1, LBOUND(Matrix, 2) TO UBOUND(Matrix, 2) - 1)
    i2 = LBOUND(Minor, 1) 'Начальное определение счетчика строк для минора
    'Цикл копирования исходной матрицы в матрицу для расчета минора:
    FOR i = LBOUND(Matrix, 1) TO UBOUND(Matrix, 1) 'Цикл копирования строк
      j2 = LBOUND(Minor, 2) 'Начальное определение счетчика столбцов для минора
      IF i = Lne THEN i = i + 1 'Пропуск "вычеркиваемой" строки
      FOR j = LBOUND(Matrix, 2) TO UBOUND(Matrix, 2) 'Цикл копирования строки
        IF j = Col THEN j = j + 1 'Пропуск "вычеркиваемго" столбца
        IF (i <= UBOUND(Matrix, 1)) AND (j <= UBOUND(Matrix, 2)) THEN
        'Блокирование выхода за границы массива
          Minor(i2, j2) = Matrix(i, j) 'Копирование элемента
          j2 = j2 + 1 'Переопределение счетчика столбцов "минора"
        END IF
      NEXT j
      i2 = i2 + 1 'Переопределение счетчика строк "минора"
    NEXT i
    GetMinor = GetDet(Minor()) 'Определение значения функции
  END IF
END FUNCTION

SUB MultiplyMatrix (A(), B(), C())  ' Процедура умножения матриц
  FOR i% = LBOUND(A, 1) TO UBOUND(A, 1) ' Цикл просмотра строк матрицы
    FOR j% = LBOUND(B, 2) TO UBOUND(B, 2) ' Цикл прсмотра элементов матрицы
      i2 = i% + LBOUND(C, 1) - LBOUND(A, 1)
      j2 = j% + LBOUND(C, 2) - LBOUND(B, 2)
      C(i2, j2) = 0   ' Обнуление элемента
      FOR k% = LBOUND(A, 2) TO UBOUND(A, 2)
                           ' Цикл формирования элементов матрицы произведения
        C(i2, j2) = C(i2, j2) + A(i%, k%) * B(k% - LBOUND(A, 2) + LBOUND(B, 1), j%)
      NEXT k%
    NEXT j%
  NEXT i%
END SUB

SUB OutMatrix (Head$, A()) 'Процедура вывода матрицы
  PRINT Head$ 'Вывод заголовка
  FOR i = LBOUND(A, 1) TO UBOUND(A, 1) 'Цикл вывода строк
    FOR j = LBOUND(A, 2) TO UBOUND(A, 2) 'Цикл вывода строки
      PRINT USING "##.##"; A(i, j); 'Вывод элемента
    NEXT j
    PRINT 'Пропуск конца строки
  NEXT i
END SUB

SUB SwapLn (A(), Ln1, Ln2) 'Функция перемены строк матрицы
  IF Ln1 <> Ln2 THEN
    FOR i = LBOUND(A, 2) TO UBOUND(A, 2) 'Цикл прохода по строке
      'Перемена элементов:
      Buf = A(Ln1, i)
      A(Ln1, i) = A(Ln2, i)
      A(Ln2, i) = Buf
    NEXT i
  END IF
END SUB


Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию