Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Паскаль
Регистрация

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

Ответ
 
Опции темы
Старый 11.06.2018, 12:27   #1
annie7
Новичок
 
Регистрация: 11.06.2018
Сообщений: 2
Репутация: 10
По умолчанию Помогите исправить результат у обратной матрицы (начальная выводиться с ошибками). Т.е. исходная матрица должна равняться стартовой. От этого ошибка в дальнейших расчетах.

Помогите исправить результат у обратной матрицы (начальная выводиться с ошибками).
Т.е. исходная матрица должна равняться стартовой. От этого ошибка в дальнейших расчетах.

Код:

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 pobochnoy 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 - Perestanovka two strok');
  writeln('2 - Transponirovanie matrix otnositelno pobochnoy diagonal');
  writeln('3 - Skalyarnoe proizvedenie stroki and stolbza');
  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;
            d[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] := d[i, j];
        writeln('Starting matrix:');np := 0;
        PrintMatr(d, b, n, 6, 1);
        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(d, b, i, j, sign(d[i, i]) * sign(d[j, i]));
          {  PrintMatr(a,b,n,6,1);}
            { Прямой ход }
          if (abs(d[i, i]) > eps) then
          begin
            MultString(d, b, i, 1 / d[i, i]);
            for j := i + 1 to n do
              AddStrings(d, b, j, i, -d[j, i]);
            {    PrintMatr(d,b,n,6,1);}
          end
          else
          begin
            writeln('Обратной матрицы не существует.');
            halt;
          end
        end;
        {writeln('Обратный ход:');}
        if (d[n, n] > eps) then
        begin
          for i := n downto 1 do
            for j := 1 to i - 1 do
            begin
              AddStrings(d, b, j, i, -d[j, i]);
            end;
          {  PrintMatr(d,b,n,8,4);}
        end
        else writeln('Обратной матрицы не существует.');
        MultMatr(a0, b, d);
        writeln('Начальная матрица, обратная к ней матрица:');
        PrintMatr(a0, b, n, 7, 3);
        writeln('Проверка: должна быть единичная матрица.');
        PrintMatr(d, d, n, 7, 3);
      end;
  end;
end.

Изображения
Тип файла: png Безымянный.png (10.4 Кб, 12 просмотров)

Последний раз редактировалось Аватар; 11.06.2018 в 12:38.
annie7 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите, из метода обратной матрицы в метод Гаусса Storgnit Помощь студентам 0 18.04.2017 01:37
помогите исправить программу не выводит результат в чем может быть ошибка xfdhjdgh Помощь студентам 6 22.12.2016 12:19
нужно найти ошибку(сама ошибка заключаеться в том что сама програма должна находить нужное число а она этого не делает) Enerdgazer Помощь студентам 0 22.12.2013 16:50
Задана исходная матрица playmakerl17 Помощь студентам 5 03.02.2011 23:59


06:17.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru