Неправильный вывод матрицы.

Общие вопросы программирования, алгоритмы и т.п.

Модератор: Модераторы

Неправильный вывод матрицы.

Сообщение Чёрный Краб » 25.03.2020 16:36:41

Неверно выводит обратную матрицу из-за неверного расчёта алгебраических дополнений.

Код: Выделить всё
Program Reshenie_Sistem_Ypavhehi;
                          Uses CRT;
                            Const
                              MaxN = 10;
                              MaxK = 10;
                              T=0.00001; {Ограничиваем числа бликие к нулю}
                               
                              Type
                                TVector = array[1..MaxN] of Real;
                                TMatrix = array[1..MaxN, 1..MaxN] of Real;
                               
                               
                               
                              Procedure ReadSystem(N: Integer; var A: TMatrix; var B: TVector);
                 {Процедура ввода расширенной матрицы}
                              Var
                                r, i, j: Integer;
                              Begin
                                r := WhereY;
                                GotoXY(2, r);
                                TextColor(12);
                                Write('A');
                                for i := 1 to n do
                                  Begin
                                    GotoXY(i*6+2, r);
                                    TextColor(11);
                                    Write(i);
                                    GotoXY(1, r+i+1);
                                    TextColor(11);
                                    Write(i:2);
                                  End;
                                GotoXY((n+1)*6+2, r);
                                TextColor(12);
                                Write('B');
                                TextColor(7);
                                for i := 1 to n do
                                  Begin
                                    For j := 1 to n do
                                      Begin
                                        GotoXY(j*6+2, r+i+1);
                                        Readln(A[i,j]);
                                      End;
                                    GotoXY((n+1)*6+2, r+i+1);
                                    Readln(B[i]);
                                  End;
                              End;
                               
                               
                               
                              Procedure Vyvod (var a: TMatrix; n:integer);
                 {Процедура вывода матрицы на экран}
                              Var
                                i,j: integer;
                              Begin
                                for i:= 1 to n do
                                  Begin
                                    for j:= 1 to n do
                                      Write ('|',A[i,j]:8:2,'|'); {Вывод матрицы с отступами}
                                    Writeln;
                                  End;
                              End;                                                                                         
                               
                              Procedure Per(k,n:integer; var a:TMatrix; var p:integer);
                 {Процедура переустановки строк, чтобы главный элемент не оказался 0 или близким к 0 значением}
                              Var
                                i,j: integer;
                                z: real;
                              Begin
                                z:= abs(a[k,k]); {После...}
                                i:= k; {каждого...}
                                p:= 0; {преобразования...}
                                for j:= k+1 to n do  {ищем по оствшимся строкам...}
                                  Begin
                                    if abs(a[j,k]) > z then {максимальный по модулю элемент}
                                      Begin
                                        z:= abs(a[j,k]); {Запоминаем...}
                                        i:= j;  {номер строки}
                                        p:= p+1; {Считаем кол-во переустановок, т.к. в каждой...}
                                                 {переустановке меняется знак определителя}
                                      End;
                                  End;
                                if i > k then  {Если эта строка ниже данной}
                                  for j:= k to n do
                                    Begin
                                      z:= a[i,j]; {тогда}
                                      a[i,j]:= a[k,j]; {делаем}
                                      a[k,j]:= z; {переустановку}
                                    End;
                              End;
                             
                         {Изменение знака при переустановке строк матрицы}
                                                      Function Znak(p:integer):integer;
                                                        Begin
                                                          if p mod 2=0 then {Если четное кол-во переустановок...}
                                                          znak:=1 else znak:=-1; {"+", если нет "-"}
                                                        End;

                         {Изменение знака при переустановке строк при нахождении дополнений}
                                                      Function Znak1(i,m:integer):integer;
                                                        Begin
                                                          if (i+m) mod 2=0 then
                                                          znak1:=1 else znak1:=-1;
                                                        End;
                                                       
                         {Процедура вычисления определителя матрицы}
                                                  Procedure opr(n, p:integer; var a:TMatrix; var det:real; var f:byte);
                                                      Var k, i, j:integer;
                                                              delenie:real;
                                                  Begin
                                                        det:=1;
                                                        f:=0;
                                                      For k:=1 to n do
                                                        Begin
                                                          if a[k,k]=0 then {Если главный элемент = 0,}
                                                            Per(k,n,a,p); {делаем переустановку}
                                                          det:=Znak(p) * det * a[k,k]; {Меняем знак определителя}
                                                        if abs(det)<t then {Если модуль определителя меньше константы...}
                                                        Begin
                                                          f:=1;
                                                          writeln ('Обратной матрицы нет!'); {выводим, что обр матрицы нет}
                                                            readln;
                                                          exit;
                                                        End;
                                                          For j:=k+1 to n do  {Ниже делаем преобразования}
                                                            Begin
                                                            delenie:=a[j,k]/a[k,k];
                                                              For i:=k to n do
                                                            Begin
                                                              a[j,i]:=a[j,i] - delenie * a[k,i];
                                                            End;
                                                        End;
                                                    End;
                                                 End;
                                                 
                         {Процедура вычисления определений для дополнений}
                                            procedure opr1(n, p:integer; d:Tmatrix; var det1:real);
                                            var k, i, j:integer;
                                                delenie:real;
                                            begin
                                             det1:=1.0;
                                              for k:=2 to n do
                                               begin
                                                if d[k,k]=0 then {Если главный элемент = 0,}
                                                   Per(k,n,d,p); {делаем переустановку}
                                                for j:=k+1 to n do  {Ниже делаем преобразования}
                                                 begin
                                                  delenie:=d[j,k]/d[k,k];
                                                   for i:=k to n do
                                                    begin
                                                     d[j,i]:=d[j,i] - delenie * d[k,i];
                                                    end;
                                                 end;
                                               end;
                                            end;

                         {Процедура вычисления дополнений}
                                            procedure Peresch(n,p:integer; var U:Tmatrix; det1:real; var a:Tmatrix);
                                            var i,m,k,j:integer;
                                                z:real;
                                                d,c:Tmatrix;
                                            begin
                                             for i:=1 to n do
                                             for m:=1 to n do
                                              begin
                                               for j:= 1 to n do {Переустановка строк}
                                                begin
                                                 z:=U[i,j];
                                                  for k:=i downto 2 do
                                                  d[k,j]:=U[k-1,j];
                                                   for k:=i+1 to n do
                                                    d[k,j]:=U[k,j];
                                                    d[1,j]:=z;
                                                end;
                                                 for k:=1 to n do {Переустановка столбцов}
                                                  begin
                                                   z:=d[k,m];
                                                    for j:=m downto 2 do
                                                     c[k,j]:=d[k,j-1];
                                                      for j:=m+1 to n do
                                                       c[k,j]:=d[k,j];
                                                       c[k,1]:=z;
                                                  end;
                                                 Opr1(n,p,c,det1);{Вычисление определителей}
                                                 a[i,m]:=det1*znak1(i,m);{Вычисление дополнений}
                                               end;
                                             end;
                                             
                                             
                          {Процедура траспонирования матрицы}
                                          Procedure Transp(a:Tmatrix; n:integer; var at:Tmatrix);
                                           var k,j:integer;
                                           begin
                                            for k:=1 to n do
                                             for j:=1 to n do
                                             at[k,j]:=a[j,k];
                                          end;
                                         
                                                                                 
                                    Procedure Transp1(var a: TMatrix; n:integer);
                         {Процедура вывода транспонированной матрицы на экран}
                              Var
                                k,j: integer;
                              Begin
                                for k:= 1 to n do
                                  Begin
                                    for j:= 1 to n do
                                       Write ('|',A[j,k]:8:2,'|'); {Вывод транспонированной матрицы}
                                    Writeln;
                                  End;
                              End; 
                               
                                Procedure Dop(var a: TMatrix; n:integer);
                         {Процедура вывода дополнений на экран}
                              Var
                                i,m: integer;
                               
                              Begin
                                for i:= 1 to n do
                                  Begin
                                    for m:= 1 to n do
                                       Write ('|',a[i,m]:8:2,'|'); {Вывод дополнений матрицы}
                                    Writeln;
                                  End;
                              End;
                             
                                         
                               
                              Var
                                n,k,j,p: Integer;
                                f:Byte;
                                det,det1:Real;
                                at,U:Tmatrix;
                                a: TMatrix ;
                                b: TVector;
                               
                               
                              Begin
                                ClrScr;
                                Write('Введите порядок матрицы системы (макс. 10): ');
                                repeat
                                  Readln(n);
                                until (n > 0) and (n <= maxn);
                                Writeln;
                                Writeln('Введите расширенную матрицу системы');
                                ReadSystem(n, a, b);
                                Writeln;
                                Writeln('Исходная матрица, без коэффициентов:');
                                Vyvod(a,n);
                                Writeln;
                                Readln;
                               
                                Writeln('Транспонированная матрица');
                                   Transp1(a,n);
                                Writeln;
                                                               
                                Opr(n,p,a,det,f); {Вычисление определителя}
                                     write('Определитель = ',det:2:0, '.');
                                        Writeln;
                                       
                                         
                                 
                                 Writeln('Матрица дополнений');
                                   Dop(a,n);
                                 Writeln;
                                                                                                                                                                                                                                                                 
                                Writeln('Обратная матрица:');
                                      for k:=1 to n do
                                        for j:=1 to n do
                                         a[k,j]:=a[k,j]/det; {Создаем обратную матрицу}
                                         Vyvod (a,n);
                                       Writeln;
                              End.


Не подскажите, в чём может быть ошибка, полагаю, что программа не дописана?, но процедуры вроде правильные(. . .
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Неправильный вывод матрицы.

Сообщение Дож » 26.03.2020 02:33:43

Какая процедура считает дополнения? Peresch? Где она вызывается?
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 849
Зарегистрирован: 12.10.2008 16:14:47

Re: Неправильный вывод матрицы.

Сообщение Чёрный Краб » 26.03.2020 16:07:05

Код: Выделить всё
Program Reshenie_Sistem_Ypavhehi;
                          Uses CRT;
                            Const
                              MaxN = 10;
                              MaxK = 10;
                              T=0.00001; {Ограничиваем числа бликие к нулю}
                               
                              Type
                                TVector = array[1..MaxN] of Real;
                                TMatrix = array[1..MaxN, 1..MaxN] of Real;
                               
                               
                               
                              Procedure ReadSystem(N: Integer; var A: TMatrix; var B: TVector);
                 {Процедура ввода расширенной матрицы}
                              Var
                                r, i, j: Integer;
                              Begin
                                r := WhereY;
                                GotoXY(2, r);
                                TextColor(12);
                                Write('A');
                                for i := 1 to n do
                                  Begin
                                    GotoXY(i*6+2, r);
                                    TextColor(11);
                                    Write(i);
                                    GotoXY(1, r+i+1);
                                    TextColor(11);
                                    Write(i:2);
                                  End;
                                GotoXY((n+1)*6+2, r);
                                TextColor(12);
                                Write('B');
                                TextColor(7);
                                for i := 1 to n do
                                  Begin
                                    For j := 1 to n do
                                      Begin
                                        GotoXY(j*6+2, r+i+1);
                                        Readln(A[i,j]);
                                      End;
                                    GotoXY((n+1)*6+2, r+i+1);
                                    Readln(B[i]);
                                  End;
                              End;
                               
                               
                               
                              Procedure Vyvod (var a: TMatrix; n:integer);
                 {Процедура вывода матрицы на экран}
                              Var
                                i,j: integer;
                              Begin
                                for i:= 1 to n do
                                  Begin
                                    for j:= 1 to n do
                                      Write ('|',A[i,j]:8:2,'|'); {Вывод матрицы с отступами}
                                    Writeln;
                                  End;
                              End;                                                                                         
                               
                              Procedure Per(k,n:integer; var a:TMatrix; var p:integer);
                 {Процедура переустановки строк, чтобы главный элемент не оказался 0 или близким к 0 значением}
                              Var
                                i,j: integer;
                                z: real;
                              Begin
                                z:= abs(a[k,k]); {После...}
                                i:= k; {каждого...}
                                p:= 0; {преобразования...}
                                for j:= k+1 to n do  {ищем по оствшимся строкам...}
                                  Begin
                                    if abs(a[j,k]) > z then {максимальный по модулю элемент}
                                      Begin
                                        z:= abs(a[j,k]); {Запоминаем...}
                                        i:= j;  {номер строки}
                                        p:= p+1; {Считаем кол-во переустановок, т.к. в каждой...}
                                                 {переустановке меняется знак определителя}
                                      End;
                                  End;
                                if i > k then  {Если эта строка ниже данной}
                                  for j:= k to n do
                                    Begin
                                      z:= a[i,j]; {тогда}
                                      a[i,j]:= a[k,j]; {делаем}
                                      a[k,j]:= z; {переустановку}
                                    End;
                              End;
                             
                         {Изменение знака при переустановке строк матрицы}
                                                      Function Znak(p:integer):integer;
                                                        Begin
                                                          if p mod 2=0 then {Если четное кол-во переустановок...}
                                                          znak:=1 else znak:=-1; {"+", если нет "-"}
                                                        End;

                         {Изменение знака при переустановке строк при нахождении дополнений}
                                                      Function Znak1(i,m:integer):integer;
                                                        Begin
                                                          if (i+m) mod 2=0 then
                                                          znak1:=1 else znak1:=-1;
                                                        End;
                                                       
                         {Процедура вычисления определителя матрицы}
                                                  Procedure opr(n, p:integer; var a:TMatrix; var det:real; var f:byte);
                                                      Var k, i, j:integer;
                                                              delenie:real;
                                                  Begin
                                                        det:=1;
                                                        f:=0;
                                                      For k:=1 to n do
                                                        Begin
                                                          if a[k,k]=0 then {Если главный элемент = 0,}
                                                            Per(k,n,a,p); {делаем переустановку}
                                                          det:=Znak(p) * det * a[k,k]; {Меняем знак определителя}
                                                        if abs(det)<t then {Если модуль определителя меньше константы...}
                                                        Begin
                                                          f:=1;
                                                          writeln ('Обратной матрицы нет!'); {выводим, что обр матрицы нет}
                                                            readln;
                                                          exit;
                                                        End;
                                                          For j:=k+1 to n do  {Ниже делаем преобразования}
                                                            Begin
                                                            delenie:=a[j,k]/a[k,k];
                                                              For i:=k to n do
                                                            Begin
                                                              a[j,i]:=a[j,i] - delenie * a[k,i];
                                                            End;
                                                        End;
                                                    End;
                                                 End;
                                                 
                         {Процедура вычисления определений для дополнений}
                                            procedure opr1(n, p:integer; d:Tmatrix; var det1:real);
                                            var k, i, j:integer;
                                                delenie:real;
                                            begin
                                             det1:=1.0;
                                              for k:=2 to n do
                                               begin
                                                if d[k,k]=0 then {Если главный элемент = 0,}
                                                   Per(k,n,d,p); {делаем переустановку}
                                                for j:=k+1 to n do  {Ниже делаем преобразования}
                                                 begin
                                                  delenie:=d[j,k]/d[k,k];
                                                   for i:=k to n do
                                                    begin
                                                     d[j,i]:=d[j,i] - delenie * d[k,i];
                                                    end;
                                                 end;
                                               end;
                                            end;

                         {Процедура вычисления дополнений}
                                            procedure Peresch(n,p:integer; var U:Tmatrix; det1:real; var a:Tmatrix);
                                            var i,m,k,j:integer;
                                                z:real;
                                                d,c:Tmatrix;
                                            begin
                                             for i:=1 to n do
                                             for m:=1 to n do
                                              begin
                                               for j:= 1 to n do {Переустановка строк}
                                                begin
                                                 z:=U[i,j];
                                                  for k:=i downto 2 do
                                                  d[k,j]:=U[k-1,j];
                                                   for k:=i+1 to n do
                                                    d[k,j]:=U[k,j];
                                                    d[1,j]:=z;
                                                end;
                                                 for k:=1 to n do {Переустановка столбцов}
                                                  begin
                                                   z:=d[k,m];
                                                    for j:=m downto 2 do
                                                     c[k,j]:=d[k,j-1];
                                                      for j:=m+1 to n do
                                                       c[k,j]:=d[k,j];
                                                       c[k,1]:=z;
                                                  end;
                                                 Opr1(n,p,c,det1);{Вычисление определителей}
                                                 a[i,m]:=det1*znak1(i,m);{Вычисление дополнений}
                                               end;
                                             end;
                                             
                                             
                          {Процедура траспонирования матрицы}
                                          Procedure Transp(a:Tmatrix; n:integer; var at:Tmatrix);
                                           var k,j:integer;
                                           begin
                                            for k:=1 to n do
                                             for j:=1 to n do
                                             at[k,j]:=a[j,k];
                                          end;
                                         
                                                                                 
                                    Procedure Transp1(var a: TMatrix; n:integer);
                         {Процедура вывода транспонированной матрицы на экран}
                              Var
                                k,j: integer;
                              Begin
                                for k:= 1 to n do
                                  Begin
                                    for j:= 1 to n do
                                       Write ('|',A[j,k]:8:2,'|'); {Вывод транспонированной матрицы}
                                    Writeln;
                                  End;
                              End; 
                               
                                Procedure Dop(var a: TMatrix; n:integer);
                         {Процедура вывода дополнений на экран}
                              Var
                                i,m: integer;
                               
                              Begin
                                for i:= 1 to n do
                                  Begin
                                    for m:= 1 to n do
                                       Write ('|',a[i,m]:8:2,'|'); {Вывод дополнений матрицы}
                                    Writeln;
                                  End;
                              End;
                             
                                         
                               
                              Var
                                n,k,j,p: Integer;
                                f:Byte;
                                det,det1:Real;
                                at,U:Tmatrix;
                                a: TMatrix ;
                                b: TVector;
                               
                               
                              Begin
                                ClrScr;
                                Write('Введите порядок матрицы системы (макс. 10): ');
                                repeat
                                  Readln(n);
                                until (n > 0) and (n <= maxn);
                                Writeln;
                                Writeln('Введите расширенную матрицу системы');
                                ReadSystem(n, a, b);
                                Writeln;
                                Writeln('Исходная матрица, без коэффициентов:');
                                Vyvod(a,n);
                                Writeln;
                                Readln;
                               
                                Writeln('Транспонированная матрица');
                                   Transp1(a,n);
                                Writeln;
                                                               
                                Opr(n,p,a,det,f); {Вычисление определителя}
                                     write('Определитель = ',det:2:0, '.');
                                        Writeln;
                                       
                                        if f=1 then exit;
                                            Transp (a,n,at);
                                          Peresch(n,p,u,det1,a);
                                        Writeln;
                                       
                                         
                                 
                                 Writeln('Матрица дополнений');
                                   Dop(a,n);
                                 Writeln;
                                                                                                                                                                                                                                                                 
                                Writeln('Обратная матрица:');
                                      for k:=1 to n do
                                        for j:=1 to n do
                                         a[k,j]:=a[k,j]/det; {Создаем обратную матрицу}
                                         Vyvod (a,n);
                                       Writeln;
                              End.



Вот в этом куске, он в самом низу.

Код: Выделить всё
  if f=1 then exit;
                                            Transp (a,n,at);
                                          Peresch(n,p,u,det1,a);
                                        Writeln;

Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Неправильный вывод матрицы.

Сообщение Дож » 26.03.2020 21:31:14

Вот вызывается функция Peresch(n,p,u,det1,a), что из параметров у неё входная матрица? u? Где это u проинициализировано?
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 849
Зарегистрирован: 12.10.2008 16:14:47

Re: Неправильный вывод матрицы.

Сообщение Чёрный Краб » 28.03.2020 12:21:21

Входная матрица a. В u он выполняет действия в процедуре, получается, нужно видоизменить процедуру дополнений, чтобы u там не было, а была только исходная матрица? НО получается, что программа выполняет действия с матрицами просто не правильно высчитывает, не пойму ошибка логическая или в расчётах что-то не так?
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Неправильный вывод матрицы.

Сообщение Дож » 28.03.2020 12:29:29

Входная матрица a. В u он выполняет действия в процедуре

Перечитайте свой же код, чтобы убедиться, что это не так
Код: Выделить всё
                         {Процедура вычисления дополнений}
                                            procedure Peresch(n,p:integer; var U:Tmatrix; det1:real; var a:Tmatrix);
                                            var i,m,k,j:integer;
                                                z:real;
                                                d,c:Tmatrix;
                                            begin
                                             for i:=1 to n do
                                             for m:=1 to n do
                                              begin
                                               for j:= 1 to n do {Переустановка строк}
                                                begin
                                                 z:=U[i,j];
                                                  for k:=i downto 2 do
                                                  d[k,j]:=U[k-1,j];
                                                   for k:=i+1 to n do
                                                    d[k,j]:=U[k,j];
                                                    d[1,j]:=z;
                                                end;


НО получается, что программа выполняет действия с матрицами просто не правильно высчитывает, не пойму ошибка логическая или в расчётах что-то не так?

Какими бы ни были рассчёты, если в них передать случайные данные, на выходе будет случайный результат.
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 849
Зарегистрирован: 12.10.2008 16:14:47

Re: Неправильный вывод матрицы.

Сообщение Чёрный Краб » 28.03.2020 15:54:06

Значит параметры неправильно задал(
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Неправильный вывод матрицы.

Сообщение Дож » 28.03.2020 18:52:23

Можно добавить u:=a; перед вызовом Peresch
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 849
Зарегистрирован: 12.10.2008 16:14:47

Re: Неправильный вывод матрицы.

Сообщение Чёрный Краб » 31.03.2020 13:20:30

Добавил, но он по прежнему ставит одно значение на всю матрицу, может он так и должен программно делать тут же точное вычисление, просто когда в калькуляторе допустим забиваю матрицу там он дополнения высчитывает разные так как и элементы матрицы резные, а тут как то непонятно.

Добавлено спустя 28 минут 25 секунд:
Прошу прощения, уже более менее понятно.
Если поставить вывод дополнений выше условия ограничения, то он выводит некоторые дополнения, но с нулями, как по методу гаусса.

Код: Выделить всё
Writeln('Матрица дополнений');
                                   Dop(a,n);
                                 Writeln;

                                        if f=1 then exit;
                                            Transp (a,n,at);
                                          Peresch(n,p,u,det1,a);
                                        Writeln;
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26


Вернуться в Общее

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 5

Рейтинг@Mail.ru