Не выводит решение.

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

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

Не выводит решение.

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

Не подскажите почему не считает решение исходя из матрицы.

Вот код.

Код: Выделить всё
Program Vot_eto_pravilno;


                              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 U: 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('U');
                                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(U[i]);
                                  End;
                              End;
                             
                             
                                      procedure Per(n,k:integer;a:TMatrix;var p:integer);{перестановка строк с макс. главным элементом}
                                      var z:real;
                                          j,i:integer;
                                      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;a:TMatrix;var det:real;var f:byte);{нахождение определителя матрицы}
                                      var k,i,j:integer;
                                          r:real;
                                      begin
                                      det:=1.0;f:=0;
                                      for k:=1 to n do
                                         begin
                                           if a[k,k]=0 then 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
                                               r:=a[j,k]/a[k,k];
                                               for i:=k to n do
                                               a[j,i]:=a[j,i]-r*a[k,i];
                                              end;
                                         end;
                                      end;

                                      procedure opr1(n,p:integer;d:Tmatrix;var det1:real);{нахождение определений для дополнений}
                                      var k,i,j:integer;
                                          r:real;
                                      begin
                                      det1:=1.0;
                                      for k:=2 to n do
                                         begin
                                           if d[k,k]=0 then per(n,k,d,p);
                                           det1:=znak(p)*det1*d[k,k];
                                           for j:=k+1 to n do
                                             begin
                                               r:=d[j,k]/d[k,k];
                                               for i:=k to n do
                                               d[j,i]:=d[j,i]-r*d[k,i];
                                             end;
                                         end;
                                      end;

                                      Procedure Peresch(n,p:integer;var b:Tmatrix;det1:real;var e: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:=b[i,j];
                                               for k:=i downto 2 do
                                               d[k,j]:=b[k-1,j];
                                               for k:=i+1 to n do
                                               d[k,j]:=b[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);{вычисление определителей}
                                           e[i,m]:=det1*znak1(i,m);{вычисление дополнений}
                                         end;
                                      end;


                                    Procedure Proverka(a,b:Tmatrix; n:integer;var c:Tmatrix);{проверка - умножение прямой матрицы на обратную}
                                    var k,j,i:integer;
                                        z:double;
                                    begin
                                    for k:=1 to n do
                                    for j:=1 to n do
                                      begin
                                        c[k,j]:=0;
                                        for i:=1 to n do
                                          begin
                                            z:=a[i,j]*b[k,i];
                                            c[k,j]:=c[k,j]+z;
                                          end;
                                       end;
                                    end;

                                    procedure Vyvod(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[k,j]:7:2);
                                        writeln;
                                      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 e: TMatrix; n:integer);
                         {Процедура вывода дополнений на экран}
                              Var
                                i,m: integer;
                               
                              Begin
                                for i:= 1 to n do
                                  Begin
                                    for m:= 1 to n do
                                       Write ('|',e[i,m]:8:2,'|'); {Вывод дополнений матрицы}
                                    Writeln;
                                  End;
                              End;
                             
                             Procedure Reshenie_lin_Yravneni(n: Integer; a: TMatrix; U: TVector; var x:TVector);
                             Var
                              k, l, i, j: Integer;
                              p:Real;

                              Begin
                               Writeln('Вычисление решения линейных уравнений');
                              For i := n - 1 downto 1 do begin
                                p:=0;
                              For j := 1 to n-i do
                                p := p + a[i, i + j] * x[i + j];
                                x[i] := (1 / a[i, i]) * (U[i] - p);
                              end;
                            End;
                             
                              { Процедура вывода результатов }
                               Procedure WriteX(n :Integer; x: TVector);
                             Var
                               i: Integer;
                              Begin
                                For i := 1 to n do
                                  Writeln('x', i, ' = ', x[i]);
                              End;

                          var
                           n,k,j,i,p: Integer;{n-размер матрицы,k-счетчик по строкам,j-счетчик по столбцам,p-счетчик перестановок}
                           a,at,b,c,e:Tmatrix;{a-исходная, at-транспонированная, b-матрица дополнений, e-обратная, с-проверка}
                           det,det1:real;{det-определитель исходной матрицы,det1-определители-дополнения}
                           f:byte;{признак несуществования обратной матрицы}
                           U,x: TVector;
                               
                         
                             
                            Begin
                                ClrScr;
                                Write('Введите порядок матрицы системы (макс. 10): ');
                                repeat
                                  Readln(n);
                                until (n > 0) and (n <= maxn);
                                Writeln;
                                Writeln('Введите расширенную матрицу системы');
                                ReadSystem(n, a, u);
                                Writeln;
                                Writeln('Исходная матрица, без коэффициентов:');
                                Vyvod(a,n);
                                Writeln;
                                Readln;
                               
                                Opr(n,p,a,det,f); {Вычисление определителя}
                                     write('Определитель = ',det:2:0, '.');
                                        Writeln;
                             
                               
                                Writeln('Транспонированная матрица');
                                   Transp1(a,n);
                                Writeln;
                                                                                                                                                                                       
                               
                                if f=1 then exit;
                                Transp(a,n,b);  {транспонируем матрицу}
                                Peresch(n,p,b,det1,e);  {считаем дополнения}
                               
                               
                               
                               
                               
                                 Writeln('Матрица дополнений');
                                   Dop(e,n);
                                 Writeln;
                         
                          writeln('Обратная матрица:');
                          for k:=1 to n do
                          for j:=1 to n do
                          e[k,j]:=e[k,j]/det; {создаем обратную матрицу}
                          Vyvod(e,n);
                         
                          writeln('Проверка:');
                          Proverka(a,e,n,c);  {делаем проверку}
                          Vyvod(c,n);
                          readln;
                         
                             
                              Writeln('Результаты вычисления');
                                 WriteX(n, x);
                              Writeln;
                         
                         
                          end.


Процедура решения системы называется Reshenie_Lin_Yravnen;

Вывод осуществляется в самом низу программы.

Можете подсказать, где ошибка в процедуре, вроде переменные все стоят правильно, убрать даже если P;=0 в цикле всё равно ставит нули.

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

Re: Не выводит решение.

Сообщение Seenkao » 05.04.2020 20:08:22

эта процедура даже ни где не вызывается...
Seenkao
энтузиаст
 
Сообщения: 502
Зарегистрирован: 01.04.2020 03:37:12

Re: Не выводит решение.

Сообщение Чёрный Краб » 06.04.2020 14:55:00

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

Re: Не выводит решение.

Сообщение Дож » 06.04.2020 19:21:51

Чёрный Краб, ничто не может вывести решение за Reshenie_Lin_Yravnen, если Reshenie_Lin_Yravnen нигде не вызывается.

Нажмите Ctrl+F (поиск по странице), наберите Reshenie_Lin_Yravnen и убедитесь, что эта функция нигде не вызывается.
Аватара пользователя
Дож
энтузиаст
 
Сообщения: 899
Зарегистрирован: 12.10.2008 16:14:47

Re: Не выводит решение.

Сообщение CynicRus » 06.04.2020 21:29:24

Ну и отформатировать бы по человечески не мешало, глаза же сломать можно.
CynicRus
постоялец
 
Сообщения: 106
Зарегистрирован: 28.06.2012 14:31:11


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

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

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

Рейтинг@Mail.ru