Обратная матрица методом Гаусса

xslayx · #1 18.10.2011, 19:59

Нужно написать программу в Delphi нахождения обратной матрицы методом Гаусса, а также промежуточные расширенные матрицы, которые получаем из первоначальной расширенной матрицы после каждого шага в методе гаусса вывести в Memo или label!!! Помогите кто чем сможет, я в матрицах не очень разбираюсь, может процедуру напишите или полезную ссылку дайте, может кто и целую программу сможет!

freedomman · #2 18.10.2011, 20:37

когда то писал что то подобное, но сейчас уже не вспомню, гугл в помощь, когда писал он мне очень помог

DelphiM0ZG · #3 22.10.2011, 18:35

Цитата:

Сообщение от xslayx

Нужно написать программу в Delphi нахождения обратной матрицы методом Гаусса, а также промежуточные расширенные матрицы, которые получаем из первоначальной расширенной матрицы после каждого шага в методе гаусса вывести в Memo или label!!! Помогите кто чем сможет, я в матрицах не очень разбираюсь, может процедуру напишите или полезную ссылку дайте, может кто и целую программу сможет!

Если, промежуточные матрицы в десятичных дробях будут, то, как, сойдёт, или же нужно в нормальных дробях?

DelphiM0ZG · #4 22.10.2011, 21:58

Я тут недавно наткнулся на свой курсач двухлетней давности, там писал функцию для нахождения определителя методом Гаусса, немного переделал, и получилась нормальная прога с интерфейсом. На самом деле я и сам давно хотел написать эту прогу, а недавно она мне, скорее всего, самому понадобится, только мне нужно, чтобы дроби нормальные были, а не десятичные, потому, что мне программу-обучалку написать надо. В коде есть комментарии, думаю, что всё будет ясно. На форме: StringGrid, Memo и BitBtn.

Вот код для кнопки "Решить":

Код:

Uses Math; // не забываем про этот модуль!

Const
  N0 = 20;
Type
  Matrix=Array[0..N0-1, 0..N0-1] Of Double;
  Massiv=Array[0..N0-1] Of Double;

procedure TGaussMethodForm.BitBtnDecideClick(Sender: TObject);
Var
   F, B: Matrix;
   w: Double;
   d, t, y, g, s: Double;
   k, c, i, j, v, kn, l, mi, mj, N: Byte;
   Str: String;
begin
  kn:=0;
   // читаю матрицу из сетки
  N:=StringGrid.ColCount;
  For i:=0 To N-1 Do
    For j:=0 To N-1 Do
       F[i, j]:=StrToFloat(StringGrid.Cells[j, i]);

  If (N<2) Then Exit;

  // приписываю к исходной матрице единичную
  For i:=0 To N-1 Do
    For j:=N To 2*N-1 Do
      If (j-i=N) Then F[i, j]:=1
      Else F[i, j]:=0;

  (* Прямой ход сверху вниз *)
  Memo.Lines.Add('---Прямой ход сверху вниз---');
  Memo.Lines.Add(#13);
  For k:=0 To N-2 Do  (* основной цикл прямого хода *)
    Begin
      D:=F[k, k]; (* ведущий элемент t=d*y => y=t/d *)
      If (d=0) Then
        Begin (* является ли ведущий элемент нулевым *)
          l:=0;
          Repeat
            l:=l+1; (* нахождение первого ненулевого элемента в столбце *)
          Until ((F[k+l, k]<>0) Or (l>=N));
          If (l<N) Then
            Begin
              For v:=k To 2*N-1 Do (* цикл, меняющий строки местами *)
                Begin
                  B[k, j]:=F[k, v];(* ведущая строка с нулевым элементом *)
                  F[k, v]:=F[k+l, v];(* эта строка теперь с ненулеывм элементом *)
                  F[k+l, v]:=B[k, j];(* та строка, которая была с нулём *)
                End;
                d:=F[k, k];(* новый ведущий элемент *)
                kn:=kn+1;(* сколько раз менялись строки *)
            End
          Else
            Exit;
        End;

      For j:=k To 2*N-1 Do B[k, j]:=F[k, j];(* сохранение исходной опорной строки в массив *)

      For c:=k+1 To N-1 Do (* цикл прокрутки столбца ведомых элементов *)
        Begin
          T:=F[c, k]; (* ведомый элемент *)
          If (t<>0) Then (* если ведомый элемент нулю ещё не равен, то: *)
            Begin
              If (d<>0) Then (* проверяю равен ли нулю ведущий элемент *)
                y:=t/d;(* разделил ведомый элемент на ведущий, и получил: *)
                      (* число, на которое нужно умножить ведущую строку *)
              For j:=k To 2*N-1 Do
                Begin
                  F[k, j]:=B[k, j];(* сохранение исходной ведущей строки *)
                  F[k, j]:=F[k, j]*y; (* умножение ведущей строки на число *)
                  F[c, j]:=F[c, j]-F[k, j];(* вычитание ведущей строки из ведомой *)
                End;
            End;
        End; (* сохранился ли ведущий элемент, если нет - возврат исходной строки *)

      If (g<>F[k, k]) Then
        For j:=k To 2*N-1 Do F[k, j]:=B[k, j];

      For mi:=0 To N-1 Do
        Begin
          Str:='';
          For mj:=0 To 2*N-1 Do
            Begin
              w:=RoundTo(F[mi, mj], -4);
              If (mj=N) Then
                Str:=Str+'  |  '+FloatToStr(w)
              Else
                Str:=Str+'  '+FloatToStr(w);
            End;
          Memo.Lines.Add(Str);
        End;
      Memo.Lines.Add(#13);
    End;

        (* матрица приведена к верхне-треугольному виду *)

  Memo.Lines.Add('---Прямой ход снизу вверх---');
  Memo.Lines.Add(#13);
  For k:=N-1 DownTo 1 Do  (* основной цикл прямого хода *)
    Begin
      D:=F[k, k]; (* ведущий элемент t=d*y => y=t/d *)
      If (d=0) Then
        Begin (* является ли ведущий элемент нулевым *)
          l:=0;
          Repeat
            l:=l+1; (* нахождение первого ненулевого элемента в столбце *)
          Until ((F[k-l, k]<>0) Or (l>=N));
          If (l<N) Then
            Begin
              For v:=k To N-1 Do (* цикл, меняющий строки местами *)
                Begin
                  B[k, j]:=F[k, v];(* ведущая строка с нулевым элементом *)
                  F[k, v]:=F[k-l, v];(* эта строка теперь с ненулеывм элементом *)
                  F[k-l, v]:=B[k, v];(* та строка, которая была с нулём *)
                End;
              d:=F[k, k];(* новый ведущий элемент *)
            End
          Else
            Exit;
        End;

      For j:=2*N-1 DownTo 0 Do B[k, j]:=F[k, j];(* сохранение исходной опорной строки в массив *)

      For c:=k+1 DownTo 0 Do (* цикл прокрутки столбца ведомых элементов *)
        Begin
          T:=F[c, k]; (* ведомый элемент *)
          If (t<>0) Then (* если ведомый элемент нулю ещё не равен, то: *)
            Begin
              If (d<>0) Then (* проверяю равен ли нулю ведущий элемент *)
                y:=t/d;(* разделил ведомый элемент на ведущий, и получил: *)
                      (* число, на которое нужно умножить ведущую строку *)
              For j:=2*N-1 DownTo 0 Do
                Begin
                  F[k, j]:=B[k, j];(* сохранение исходной ведущей строки *)
                  F[k, j]:=F[k, j]*y; (* умножение ведущей строки на число *)
                  F[c, j]:=F[c, j]-F[k, j];(* вычитание ведущей строки из ведомой *)
                End;
            End;
        End; (* сохранился ли ведущий элемент, если нет - возврат исходной строки *)

      If (g<>F[k, k]) Then
        For j:=2*N-1 DownTo 0 Do F[k, j]:=B[k, j];

      For mi:=0 To N-1 Do
        Begin
          Str:='';
          For mj:=0 To 2*N-1 Do
            Begin
              w:=RoundTo(F[mi, mj], -4);
              If (mj=N) Then
                Str:=Str+'  |  '+FloatToStr(w)
              Else
                Str:=Str+'  '+FloatToStr(w);
            End;
          Memo.Lines.Add(Str);
        End;
      Memo.Lines.Add(#13);
  End;

  For i:=0 To N-1 Do
    Begin
      d:=F[i, i];
      F[i, i]:=F[i, i]/d;
      For j:=N To 2*N Do
        F[i, j]:=F[i, j]/d;
    End;

  For mi:=0 To N-1 Do
    Begin
      Str:='';
      For mj:=0 To 2*N-1 Do
        Begin
          w:=RoundTo(F[mi, mj], -4);
          If (mj=N) Then
            Str:=Str+'  |  '+FloatToStr(w)
          Else
            Str:=Str+'  '+FloatToStr(w);
        End;
      Memo.Lines.Add(Str);
    End;
  Memo.Lines.Add(#13);

  Memo.Lines.Add('----Обратная матрица----');
  Memo.Lines.Add(#13);
  For i:=0 To N-1 Do
    Begin
      Str:='';
      For j:=N To 2*N-1 Do
        Begin
          w:=RoundTo(F[i, j], -4);
          Str:=Str+' '+FloatToStr(w);
        End;
      Memo.Lines.Add(Str);
    End;
end;

Матрицу находит правильно: я в Excel-е несколько раз проверял. Только, вот выводить её в Memo не очень удобно, лучше, конечно же, в StringGrid.

krasich · #5 23.10.2011, 11:28

DelphiM0ZG
А вы могли бы разместить исходный код вычисления определителя методом Гаусса?

DelphiM0ZG · #6 23.10.2011, 13:05

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

Код:

Const
  N0=20;

Type
  Matrix=Array[0..N0-1, 0..N0-1] Of Extended;

Function MatrixOpred(F: Matrix; Const N: Byte):Extended;
Var
   B: Matrix;
   d, t, y, g, s: Extended;
   k, c, i, j, v, kn, l: Byte;
Begin  (* начало функции *)
  kn:=0;
  If (N=1) Then D:=F[0, 0] (* определитель матрицы, состоящей из одного элемента *)
  Else If (N=2) Then D:=F[0, 0]*F[1, 1]-F[0, 1]*F[1, 0] (* если матрица 2*2 *)
  Else
    Begin (* если размер матрицы больше, чем 2 *)
      For k:=0 To N-2 Do  (* основной цикл прямого хода *)
        Begin
          D:=F[k, k]; (* ведущий элемент t=d*y => y=t/d *)
          If (d=0) Then
            Begin (* является ли ведущий элемент нулевым *)
              l:=0;
              Repeat
                l:=l+1; (* нахождение первого ненулевого элемента в столбце *)
              Until ((F[k+l, k]<>0) Or (l>=N));
              If (l<N) Then
                Begin
                  For v:=k To N-1 Do (* цикл, меняющий строки местами *)
                    Begin
                      B[k, v]:=F[k, v];(* ведущая строка с нулевым элементом *)
                      F[k, v]:=F[k+l, v];(* эта строка теперь с ненулеывм элементом *)
                      F[k+l, v]:=B[k, v];(* та строка, которая была с нулём *)
                    End;
                  d:=F[k, k];(* новый ведущий элемент *)
                  kn:=kn+1;(* сколько раз менялись строки *)
                End
              Else
                Begin
                  MatrixOpred:=0;
                  Exit;
                End;
            End;

            For j:=k To N-1 Do B[k, j]:=F[k, j];(* сохранение исходной опорной строки в массив *)

            For c:=k+1 To N-1 Do (* цикл прокрутки столбца ведомых элементов *)
              Begin
                T:=F[c, k]; (* ведомый элемент *)
                If (t<>0) Then (* если ведомый элемент нулю ещё не равен, то: *)
                  Begin
                    If (d<>0) Then (* проверяю равен ли нулю ведущий элемент *)
                      y:=t/d;(* разделил ведомый элемент на ведущий, и получил: *)
                      (* число, на которое нужно умножить ведущую строку *)
                      For j:=k To N-1 Do
                        Begin
                          F[k, j]:=B[k, j];(* сохранение исходной ведущей строки *)
                          F[k, j]:=F[k, j]*y; (* умножение ведущей строки на число *)
                          F[c, j]:=F[c, j]-F[k, j];(* вычитание ведущей строки из ведомой *)
                        End;
                  End;
              End; (* сохранился ли ведущий элемент, если нет - возврат исходной строки *)

            If (g<>F[k, k]) Then
              For j:=k To N-1 Do F[k, j]:=B[k, j];
        End;
        (* матрица приведена к верхне-треугольному виду *)
      D:=1;(* вычисляем определитель *)
      j:=0;
      For i:=0 To N-1 Do
        Begin
          D:=D*F[i, j]; (* перемножаем элементы главной диагонали *)
          Inc(j);
        End;
      (* если строку меняли нечётное количество раз, то умножаем определитель на (-1) *)
      If (Odd(Kn)) Then D:=-D;
    End;
  MatrixOpred:=D;(* имя функции равно полученному результату *)
End;

xslayx · #7 25.10.2011, 17:02

DelphiM0ZG Спасибо вам огромнейшее, все очень хорошо написано, описано, то что мне нужно и даже больше)

Tasha · #8 30.01.2012, 19:33

Помогите пожалуйста написать код программы которая генерирует и находит ранг матрицы!!!!!!!!!!!!!!!!!Очень нужно(

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо DelphiM0ZG за это полезное сообщение:
lokomotiv59 (31.10.2013)