Не пойму, почему не правильно выводит решение.

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

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

Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 13.04.2020 13:43:07

Процедура не правильно выводит решение системы уравнений, если задать.

Код: Выделить всё
Program Resh;
                    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 Dop(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 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('----------------------');     
                                     
                            If f=1 Then Exit;
                              Transp(a,n,b);  {Транспонируем матрицу}
                                Dop(n,p,b,det1,e); {Считаем дополнения}
                               
                              Writeln('Матрица дополнений'); {Выводим дополнения для проверки правильности вычисления}
                                 Dop(e,n);
                              Writeln;
                                 
                                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('----------------------');     
                           
                         Writeln('Проверка:');
                           Proverka(a,e,n,c); {Делаем проверку}
                           Vyvod(c,n);
                         Readln;
                         
                          Reshenie_lin_Yravneni(n,a,u,x); {Вычисляем решение системы уравнений}
                              Writeln('Результаты вычисления'); {Выводим результаты}
                                 WriteX(n, x);
                              Writeln;                   
                       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;


Вызов в самом низу в основной части:

Код: Выделить всё
Reshenie_lin_Yravneni(n,a,u,x); {Вычисляем решение системы уравнений}
                              Writeln('Результаты вычисления'); {Выводим результаты}
                                 WriteX(n, x);
                              Writeln;                   
                       End.



Ставил в процедуру обратную матрицу, то есть переменную e но это не помогло.

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

Re: Не пойму, почему не правильно выводит решение.

Сообщение Sharfik » 13.04.2020 18:11:38

А словестные комментарии можно увидеть? Что за уравнение, что и где не нравится? Что выводит при каких условиях и что должна выводить?
Sharfik
энтузиаст
 
Сообщения: 532
Зарегистрирован: 20.07.2013 01:04:30

Re: Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 13.04.2020 18:49:13

Sharfik писал(а):А словестные комментарии можно увидеть? Что за уравнение, что и где не нравится? Что выводит при каких условиях и что должна выводить?


При методе гаусса система линейных уравнений, выводит следующее решение, которое представлена на скрине:

А при решении системы линейных уравнений методом обратной матрицы, там где обратная умножается на свободные коэффициенты, из-за неправильности процедуры неверно выводит решение.

Как исправить процедуру?

Заранее спасибо.

Добавлено спустя 1 минуту 11 секунд:
Чёрт, гаусс это второе вложение, которое ниже, а первое это методом обратной матрицы.
Вложения
Снимок.PNG
Снимок.PNG
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Не пойму, почему не правильно выводит решение.

Сообщение Vadim » 14.04.2020 16:14:20

Чёрный Краб
Поскольку обратная матрица у Вас получается правильная, значит остаётся единственное место, где сидит ошибка - неправильный алгоритм умножения матрицы на вектор. Матрица может умножаться только на вектор-столбец, об этом многие забывают. Вам нужно перебирать в цикле все строки матрицы и значения каждой строки умножать на каждое значение вектора. Проще всего брать какую-нибудь готовую процедуру умножения матриц, а вектор-столбец представлять как Vector(n, 1), где n - это количество элементов одной строки матрицы.
Код: Выделить всё
Const
  nmax = 4;
Var
  a: array[1..nmax,1..nmax] of double;
  b,x: array[1..nmax] of double;
  i,j: integer;
begin
  writeln('Матрица A (уже обратная):');
  a[1,1]:=0.12;a[1,2]:=0.22;a[1,3]:=0.15;a[1,4]:=0.11;
  a[2,1]:=0.21;a[2,2]:=0.09;a[2,3]:=0.03;a[2,4]:=-0.2;
  a[3,1]:=0.31;a[3,2]:=0.11;a[3,3]:=-0.18;a[3,4]:=0.05;
  a[4,1]:=-0.24;a[4,2]:=-0.36;a[4,3]:=0.16;a[4,4]:=0.07;
  for i:=1 to nmax Do
  Begin
    For j:=1 to nmax Do
      Write(a[i,j]:6:2);
    WriteLn;
  End;

  writeln('Вектор-столбец B:');
  b[1]:=6;b[2]:=8;b[3]:=4;b[4]:=-8;
  For j:=1 to nmax Do
    WriteLn(b[j]:6:2);
  WriteLn;
 
  { Цикл умножения вектора на матрицу }
  for i:=1 to nmax do
  begin
    x[i]:=0;
    for j:=1 to nmax do
      x[i]:=x[i]+a[i,j]*b[j];
  end;

  writeln('Вектор X=А*B:');
  for i:=1 to nmax do
    writeLn(x[i]:8:2);
  WriteLn;
end.
Vadim
долгожитель
 
Сообщения: 3894
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 15.04.2020 14:01:41

Vadim писал(а):Чёрный Краб
Поскольку обратная матрица у Вас получается правильная, значит остаётся единственное место, где сидит ошибка - неправильный алгоритм умножения матрицы на вектор. Матрица может умножаться только на вектор-столбец, об этом многие забывают. Вам нужно перебирать в цикле все строки матрицы и значения каждой строки умножать на каждое значение вектора. Проще всего брать какую-нибудь готовую процедуру умножения матриц, а вектор-столбец представлять как Vector(n, 1), где n - это количество элементов одной строки матрицы.
Код: Выделить всё
Const
  nmax = 4;
Var
  a: array[1..nmax,1..nmax] of double;
  b,x: array[1..nmax] of double;
  i,j: integer;
begin
  writeln('Матрица A (уже обратная):');
  a[1,1]:=0.12;a[1,2]:=0.22;a[1,3]:=0.15;a[1,4]:=0.11;
  a[2,1]:=0.21;a[2,2]:=0.09;a[2,3]:=0.03;a[2,4]:=-0.2;
  a[3,1]:=0.31;a[3,2]:=0.11;a[3,3]:=-0.18;a[3,4]:=0.05;
  a[4,1]:=-0.24;a[4,2]:=-0.36;a[4,3]:=0.16;a[4,4]:=0.07;
  for i:=1 to nmax Do
  Begin
    For j:=1 to nmax Do
      Write(a[i,j]:6:2);
    WriteLn;
  End;

  writeln('Вектор-столбец B:');
  b[1]:=6;b[2]:=8;b[3]:=4;b[4]:=-8;
  For j:=1 to nmax Do
    WriteLn(b[j]:6:2);
  WriteLn;
 
  { Цикл умножения вектора на матрицу }
  for i:=1 to nmax do
  begin
    x[i]:=0;
    for j:=1 to nmax do
      x[i]:=x[i]+a[i,j]*b[j];
  end;

  writeln('Вектор X=А*B:');
  for i:=1 to nmax do
    writeLn(x[i]:8:2);
  WriteLn;
end.




Понимаю, но дело в том, что у меня не одна система линейных уравнений, это по типу калькулятора решения, а этот перебор, как я понял только для текущего, подскажите вот из-за куска который только что написал, выдает ошибку что нельзя преобразовать тип Real к Array, как понимаю из-за того что массив двухмерный, но как тогда правильно написать, чтобы он именно получившуюся обратную матрицу умножал на вектор U и выводил результаты.

Заранее спасибо.

Код: Выделить всё
Writeln('Произведение Матрицы на Вектор столбец:');
                              A[i,j]:=e[k,j];
                                     for i := 1 to n do
                                       begin
                                         for j := 1 to n do
                                           C[i] := a[i, j] * U[j];
                                                  Writeln(c[i]:4)
                                        End;
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Не пойму, почему не правильно выводит решение.

Сообщение Vadim » 15.04.2020 15:01:14

Чёрный Краб писал(а): ... дело в том, что у меня не одна система линейных уравнений, это по типу калькулятора решения, а этот перебор, как я понял только для текущего ...

Неправильно поняли. ;-)
Вам никто не мешает использовать динамические массивы, размер которых опирается на переменную (в моём примере - константу) - nmax. Таким образом, матрица коэффициентов и вектор свободных членов могут быть любых размеров. Алгоритм решения от размера не зависит - какие массивы скормите, такие и будут считаться.
Чёрный Краб писал(а):... подскажите вот из-за куска который только что написал, выдает ошибку что нельзя преобразовать тип Real к Array ...

В этом куске я у Вас ошибку не вижу. Когда выдаётся ошибка, компилятор, в большинстве случаев, совершенно точно показывает номер строки и номер позиции в строке, где, по его мнению, есть синтаксическая ошибка. Попробуйте сами посмотреть, т.к. я выхлопа Вашего компилятора, а так же всего кода, не вижу.
Vadim
долгожитель
 
Сообщения: 3894
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 15.04.2020 16:34:53

Vadim писал(а):
Чёрный Краб писал(а): ... дело в том, что у меня не одна система линейных уравнений, это по типу калькулятора решения, а этот перебор, как я понял только для текущего ...

Неправильно поняли. ;-)
Вам никто не мешает использовать динамические массивы, размер которых опирается на переменную (в моём примере - константу) - nmax. Таким образом, матрица коэффициентов и вектор свободных членов могут быть любых размеров. Алгоритм решения от размера не зависит - какие массивы скормите, такие и будут считаться.
Чёрный Краб писал(а):... подскажите вот из-за куска который только что написал, выдает ошибку что нельзя преобразовать тип Real к Array ...

В этом куске я у Вас ошибку не вижу. Когда выдаётся ошибка, компилятор, в большинстве случаев, совершенно точно показывает номер строки и номер позиции в строке, где, по его мнению, есть синтаксическая ошибка. Попробуйте сами посмотреть, т.к. я выхлопа Вашего компилятора, а так же всего кода, не вижу.


Сначала пытался всё засунуть и написать процедуру, но там из-за большого числа переменных, постоянные ошибки, поэтому решил сделать вот так, так как по сути что осталось сделать так это умножить получившуюся обратную матрицу, а получилась она в переменной e и перемножить её на вектор столбец, который хранится в U.

Код: Выделить всё
Program Resh;
                    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 Dop(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 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;
                             
                           
                             
                               
                           
                             
            {Основная часть}

                  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('----------------------');     
                                     
                            If f=1 Then Exit;
                              Transp(a,n,b);  {Транспонируем матрицу}
                                Dop(n,p,b,det1,e); {Считаем дополнения}
                               
                              Writeln('Матрица дополнений'); {Выводим дополнения для проверки правильности вычисления}
                                 Dop(e,n);
                              Writeln;
                                 
                                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('----------------------');     
                           
                         Writeln('Проверка:');
                           Proverka(a,e,n,c); {Делаем проверку}
                           Vyvod(c,n);
                         Readln;
                         
                         
                            Writeln('----------------------');         
                         
                          Writeln('Произведение Матрицы на Вектор столбец:');
                              A[i,j]:=e[k,j];
                                     for i := 1 to n do
                                       begin
                                         for j := 1 to n do
                                           C[i] := a[i, j] * U[j];
                                                  Writeln(c[i]:4)
                                        End;
                                       
                            Writeln('----------------------');                                                             
                       End.


Кусок программы в самом низу:


Код: Выделить всё
    Writeln('Произведение Матрицы на Вектор столбец:');
                              A[i,j]:=e[k,j];
                                     for i := 1 to n do
                                       begin
                                         for j := 1 to n do
                                           C[i] := a[i, j] * U[j];
                                                  Writeln(c[i]:4)
                                        End;


Сообщение компилятора во вложение:
Строка 284.

Ошибка вроде простая, учитывая, что постоянно используется одна и та же переменная массива, можно ли этот кусок сделать правильно, или же можно вообще назначить новые переменные и пере закинуть результат выполнения ли не так тогда всё.(
Вложения
Снимок экрана (121).png
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Не пойму, почему не правильно выводит решение.

Сообщение Vadim » 15.04.2020 17:36:13

Чёрный Краб
У Вас переменная C имеет тип TMatrix, а в строке 284 Вы ему скармливаете всего лишь один индексный элемент, хотя у этого типа должно быть два. ;-)
Vadim
долгожитель
 
Сообщения: 3894
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 15.04.2020 19:04:25

Vadim писал(а):Чёрный Краб
У Вас переменная C имеет тип TMatrix, а в строке 284 Вы ему скармливаете всего лишь один индексный элемент, хотя у этого типа должно быть два. ;-)


Спасибо.

Уже лучше, правда он всё равно неверное решение выводит.

Код: Выделить всё
Program Resh;
                    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 Dop(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 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;
                             
                           
                             
                               
                           
                             
            {Основная часть}

                  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,L: 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('----------------------');     
                                     
                            If f=1 Then Exit;
                              Transp(a,n,b);  {Транспонируем матрицу}
                                Dop(n,p,b,det1,e); {Считаем дополнения}
                               
                              Writeln('Матрица дополнений'); {Выводим дополнения для проверки правильности вычисления}
                                 Dop(e,n);
                              Writeln;
                                 
                                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('----------------------');     
                           
                         Writeln('Проверка:');
                           Proverka(a,e,n,c); {Делаем проверку}
                           Vyvod(c,n);
                         Readln;
                         
                         
                            Writeln('----------------------');         
                         
                          Writeln('Произведение Матрицы на Вектор столбец:');
                                     for i := 1 to n do
                                        begin
                                     for j := 1 to n do 
                                           L[i] := e[k, j] * U[i];
                                                  Writeln(L[i]:8:2);
                                        End;
                                       
                            Writeln('----------------------');                                                             
                       End.



Код: Выделить всё
Writeln('Произведение Матрицы на Вектор столбец:');
                                     for i := 1 to n do
                                        begin
                                     for j := 1 to n do 
                                           L[i] := e[k, j] * U[i];
                                                  Writeln(L[i]:8:2);
                                        End;
                                       
                            Writeln('----------------------');                                                             
                       End.


Выводит вот такое решение:



81 на 37 число 2.18918918919, но исходя из вот таких вычислений не одно не совпадает.

Но всё же принцип решения правильный.
Вложения
Снимок.PNG.PNG
Выводит вот такое:
Снимок.PNG.PNG (2.84 КБ) Просмотров: 873
Снимок.PNG
А примерное решение такое.
Снимок.PNG (7.65 КБ) Просмотров: 873
Чёрный Краб
новенький
 
Сообщения: 16
Зарегистрирован: 17.03.2020 16:24:26

Re: Не пойму, почему не правильно выводит решение.

Сообщение Vadim » 15.04.2020 20:04:39

Чёрный Краб
Две ошибки в цикле умножения матрицы на вектор. Попробуйте сами найти. ;-)
У Вас, случайно, со зрением проблем нет? А то у меня самого зрение неважное, я тоже, когда пишу программы, постоянно ляпаю такие детсадовские ошибки, а потом, с помощью тестов, сижу их выуживаю... :-)
Vadim
долгожитель
 
Сообщения: 3894
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 16.04.2020 14:57:23

Vadim писал(а):Чёрный Краб
Две ошибки в цикле умножения матрицы на вектор. Попробуйте сами найти. ;-)
У Вас, случайно, со зрением проблем нет? А то у меня самого зрение неважное, я тоже, когда пишу программы, постоянно ляпаю такие детсадовские ошибки, а потом, с помощью тестов, сижу их выуживаю... :-)



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

Re: Не пойму, почему не правильно выводит решение.

Сообщение Vadim » 16.04.2020 17:16:15

Чёрный Краб
1. Посмотрите, какие переменные Вы используете в циклах, а потом сравните с теми переменными, которые Вы используете для индексов матрицы.
2. Сравните в той части, что относится к умножению матрицы на вектор мой пример и то, что написано в Вашем коде.
Vadim
долгожитель
 
Сообщения: 3894
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Не пойму, почему не правильно выводит решение.

Сообщение Чёрный Краб » 16.04.2020 19:55:15

Vadim писал(а):Чёрный Краб
1. Посмотрите, какие переменные Вы используете в циклах, а потом сравните с теми переменными, которые Вы используете для индексов матрицы.
2. Сравните в той части, что относится к умножению матрицы на вектор мой пример и то, что написано в Вашем коде.




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

Re: Не пойму, почему не правильно выводит решение.

Сообщение Vadim » 17.04.2020 05:25:35

Чёрный Краб писал(а):Так тоже пробовал, понятно что переменные не совпадают, но так уж получилось, что получается 3 переменные в цикле, а присваивание, чтобы выйти на 2 переменные не получается, так как выводит ошибку, я так понял, надо писать 3 цикла, хотя он опять выводит не верно, но уже хотя_бы приблизительно числа другие получаются.

В таком случае, не знаю, чем Вам ещё можно помочь. Ваша проблема исправляется элементарно - нужно только внимательно посмотреть на код и пару раз щёлкнуть клавишами. Ну что ж, Вы свой выбор сделали и настаиваете на нём, позвольте откланяться... ;-)
Vadim
долгожитель
 
Сообщения: 3894
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск


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

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

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

Рейтинг@Mail.ru