Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.06.2018, 18:20   #1
annie7
 
Регистрация: 11.06.2018
Сообщений: 4
По умолчанию Преобразования с матрицей

Помогите написать программу для задания:

Для матрицы А=|aij|, где i изменяется от 0 до N-1, j - от 0 до N-1, написать подпрограммы, выполняющие следующие преобразования:
- транспонирование матрицы относительно главной диагонали;
- скалярное произведение заданной строки и заданного столбца;
- вычисление обратной матрицы.
Программа должна обеспечить выбор конкретного преобразования.

Уже есть наброски программы. Но результат обратной матрицы некорректный..

Код:
program lr;

type
  mtr = array[0..9, 0..9] of real;

const
  eps = 0.00001;{ all numbers less than eps are equal 0 }

var
  np: integer;
  n: byte;

procedure trans_pob(var a: mtr; n: byte);
var
  i, j: byte;
  x: real;
begin
  for i := 1 to n do
    for j := 0 to i - 1 do
    begin
      x := a[i, j];
      a[i, j] := a[j, i];
      a[j, i] := x;
    end;
  writeln('Matrix transponirovannaya otnositelno glavnoy diagonal ');
  for i := 0 to n - 1 do
  begin
    for j := 0 to n - 1 do
      write(a[i, j]:3);
    writeln;
  end;
  readln;
end;

function scal(a: mtr; n, st, sb: byte): real;
var
  i: byte;
  s: real;
begin
  s := 0;
  for i := 0 to n - 1 do
    s := s + a[st - 1, i] * a[i, sb - 1];
  scal := s;
end;

procedure PrintMatr(m, m1: mtr; n, nz, nd: integer);
var
  i, j: integer;
begin
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(m[i, j]:nz:nd);
    for j := 1 to n do
      write(m1[i, j]:nz:nd);
    writeln;
  end;
end;

procedure MultString(var a, b: mtr; i1: integer; r: real);
var
  j: integer;
begin
  for j := 1 to n do
  begin
    a[i1, j] := a[i1, j] * r;
    b[i1, j] := b[i1, j] * r;
  end;
end;

procedure AddStrings(var a, b: mtr; i1, i2: integer; r: real);
{ Процедура прибавляет к i1 строке матрицы a i2-ю умноженную на r}
var
  j: integer;
begin
  for j := 1 to n do
  begin
    a[i1, j] := a[i1, j] + r * a[i2, j];
    b[i1, j] := b[i1, j] + r * b[i2, j];
  end;
end;

procedure MultMatr(a, b: mtr; var c: mtr);
var
  i, j, k: byte;
  s: real;
begin
  for i := 1 to n do
    for j := 1 to n do
    begin
      s := 0;
      for k := 1 to n do
        s := s + a[i, k] * b[k, j];
      c[i, j] := s;
    end;
end;

function sign(r: real): shortint;
begin
  if (r >= 0) then sign := 1 else sign := -1;
end;

var
  a, b, a0, d: mtr;
  w, i, j, s1, s2: byte;

begin
  repeat
    write('Vvedite size matrix from 2 to 10, n = ');
    read(n);
  until n in [2..10];
  randomize;
  writeln('Ishodnaya matrix ');
  for i := 0 to n - 1 do
  begin
    for j := 0 to n - 1 do
    begin
      a[i, j] := 1 + random(10);
      write(a[i, j]:3);
    end;
    writeln;
  end;
  writeln('Vyberite preobrazovanie');
  writeln('1 - Transponirovanie matrix otnositelno glavnoy diagonal');
  writeln('2 - Skalyarnoe proizvedenie stroki and stolbza');
  writeln('3 - Obratnaya matrix');
  repeat
    read(w);
  until w in [1..3];
  case w of
    1: trans_pob(a, n);
    2: 
      begin
        repeat
          write('Vvedite number stroki from 1 to ', n, ' s1 = ');
          read(s1);
          if (s1 > n) then
          begin
            writeln('Stroki s vvedynnym number ne sushestvuet');
            read;
          end else
        until s1 in [1..n];
        repeat
          write('Vvedite number stolbza from 1 to ', n, ' s2 = ');
          read(s2);
          if (s2 > n) then
          begin
            writeln('Stolbza s vvedynnym number ne sushestvuet');
            read;
          end else
        until s2 in [1..n];
        writeln('Skalyarnoe proizvedenie stroki ', s1, ' and stolbza ', s2, ' = ', scal(a, n, s1, s2));
        readln;
      end;
    3:
      begin{ начало основной программы }
        for i := 1 to n do
        begin
          for j := 1 to n do
          begin
            b[i, j] := 0;
            a[i, j] := a[i, j];
          end;
          b[i, i] := 1;
        end;
        for i := 1 to n do
          for j := 1 to n do
            a0[i, j] := a[i, j];
        writeln('Starting matrix:');np := 0;
        PrintMatr(a, b, n, 6, 0);
        for i := 1 to n do
        begin
          { К i-той строке прибавляем (или вычитаем) j-тую строку
            взятую со знаком i-того элемента j-той строки. Таким образом,
            на месте элемента a[i,i] возникает сумма модулей элементов i-того
            столбца (ниже i-той строки) взятая со знаком бывшего элемента a[i,i],
            равенство нулю которой говорит о несуществовании обратной матрицы }
          for j := i + 1 to n do
            AddStrings(a, b, i, j, sign(a[i, i]) * sign(a[j, i]));
          {  PrintMatr(a,b,n,6,0);}
            { Прямой ход }
          if (abs(a[i, i]) > eps) then
          begin
            MultString(a, b, i, 1 / a[i, i]);
            for j := i + 1 to n do
              AddStrings(a, b, j, i, -a[j, i]);
            {    PrintMatr(a,b,n,6,0);}
          end
          else
          begin
            writeln('Обратной матрицы не существует.');
            halt;
          end
        end;
        {writeln('Обратный ход:');}
        if (a[n, n] > eps) then
        begin
          for i := n downto 1 do
            for j := 1 to i - 1 do
            begin
              AddStrings(a, b, j, i, -a[j, i]);
            end;
          {  PrintMatr(a,b,n,8,4);}
        end
        else writeln('Обратной матрицы не существует.');
        MultMatr(a0, b, a);
        writeln('Начальная матрица, обратная к ней матрица:');
        PrintMatr(a0, b, n, 7, 2);
        writeln('Проверка: должна быть единичная матрица.');
        PrintMatr(a, a, n, 7, 0);
      end;
  end;
end.
Пожалуйста, оформляйте Ваш код согласно правилам.
Изображения
Тип файла: png Безымянный.png (10.4 Кб, 65 просмотров)

Последний раз редактировалось Вадим Мошев; 11.06.2018 в 18:34.
annie7 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Аффинные преобразования Andry95 C# (си шарп) 0 16.05.2017 21:11
2D Афинные преобразования. Alek-de-Mik C# (си шарп) 1 08.09.2012 19:21
2D преобразования syrga Общие вопросы Delphi 1 14.05.2012 23:50
Преобразования матрицы zevs116 Помощь студентам 15 21.02.2011 19:40