Обратная матрица (nxn)

[Albenous]

Need help. Как получить обратную матрицу из исходной (разумеется, матрица nxn, где n - задается отдельно; n>3). Детерминант я нашел. Пусть он будет постоянной det. Матрица 'a'.
Кто может, помогите - нужен текст программы. Желательно - разжеванный - т.е. без экзотических компонентов, пуст и громоздко. Thanks.

Я пошел от частного к общему взял матрицу 3х3
определитель=10
ответ -5 1 4 15 3 -8 25 9 -14) * 1/10
В скобках - союзная матрица

procedure TForm1.Button2Click(Sender: TObject);
var i1,j1,i,j,n:integer; x,x1:matr; d1:real;
begin
n:=3;
x[1,1]:=3; //условие
x[1,2]:=5;
x[1,3]:=-2;
x[2,1]:=1;
x[2,2]:=-3;
x[2,3]:=2;
x[3,1]:=6;
x[3,2]:=7;
x[3,3]:=-3;
for i:= 1 to n do
for j:= 1 to n do
begin
//x[i,j]:=strtofloat(stringgrid1.cells[i,j]);
x1:=x;
for i1:= 1 to n do
for j1:= 1 to n do
begin
if (i<i1) and (j>=j1) then x1[i,j]:=x[i+1,j];
if (j<j1) and (i>=i1) then x1[i,j]:=x[i,j+1];
if (j<j1) and (i<i1) then x1[i,j]:=x[i+1,j+1];
end;
determinant(x1,n-1,d1); //d1 - ответ
stringgrid3.cells[i,j]:=floattostr((power((-1),(i+j)))*d1);
end;
end;
end.


чего не так как надо?


И СА-А-А-А-А-АМЫЙ главный вопрос - как программно найти минор n-мерной квадратной матрицы.
Кто забыл - МИНОР - остаток матрицы после вычитания строки и столбца. В тексте прогри я попытался это осуществить. Но чего-то не сходится. ответ другой.

[zetrix]

Нахождение минора:

unit Unit1;

interface

uses
  Windows, SysUtils,  Classes,  Controls, Forms,
   StdCtrls, Grids;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    StringGrid1: TStringGrid; // здесь будет выводится матрица
    procedure del(x,y:integer);
    procedure vivod;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  a:array[1..100,1..100]of integer; //сама матрица
  N,M:integer; //размер матрицы
  i,j:integer; // просто переменные

implementation

{$R *.dfm}
procedure TForm1.vivod; //вывод матицы (на сетку)
begin
for j:=1 to m do
 for i:=1 to n do
  StringGrid1.Cells[i-1,j-1]:=inttostr(a[i,j]);
end;

procedure TForm1.del(x,y:integer); //удаление х столбца и у строки  (минор[x,y])
begin
for i:=x to n do
 for j:=1 to M do a[i,j]:=a[i+1,j];
dec(N); 
for j:=y to M do
 for i:=1 to N do a[i,j]:=a[i,j+1];
dec(M) 
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
N:=7; //задание начального размаре
M:=5;
Randomize;
for j:=1 to m do
 for i:=1 to n do a[i,j]:=random(10); //произвольно забиваем матрицу
vivod; //отображаем матрицу
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
for j:=1 to m do
 for i:=1 to n do
StringGrid1.Cells[i-1,j-1]:=''; //очищаем сетку
del(strtoint(edit1.Text),strtoint(edit2.Text)); //в Эдитах задаём параметры минора (x,y)
vivod;
end;

end.

Вот исходники на делфе (без коментариев):

[Albenous]

Как говорится, Все гениальное - просто.
Надо было только несколько строчек переставить - а столько мучился.
Спасибо огромное, Zetrix.

о-паньки...
чего-то не получается с обраной матрицей...
может кто найдет ошибку?

 
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids,math;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    Edit1: TEdit;
    Label2: TLabel;
    StringGrid3: TStringGrid;
    Label3: TLabel;
    Label5: TLabel;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
 
type
   matr=array[1..20,1..20]of real;
implementation
{$R *.dfm}
 
procedure mstr(k,l:integer; var a: matr; n:integer);
//Процедура перестановки k-ой и l-ой строк в матрице а порядка n
var j : integer;
r : real;
begin
if (k<=n) and (l<=n)then
begin
for j := 1 to n do
begin
r := a[l,j];
a[l,j] :=a[k,j];
a[k,j] := r;
end;
end
end;
 
procedure DETERMINANT(var a:matr; n : integer; var det: real);
//матрица а, размерности n, det - детерминант
var i,j,k,l : integer;
k1,k2,d:real;
begin
d:=1;
for k := 1 to n-1 do
begin
if a[k,k]<>0 then  //Если ведущий элемент ненулевой
k1:=a[k,k]
else    //В противном случае: перестановка строк,...
begin
l:=k;
repeat
l:=l+1
until (a[l,k]<>0) or (l=n+1);     //ищем первый ненулевой элемент данного столбца, стоящий ниже диагонального,...
if l<=n then //если такой элемент найден,...
begin
mstr(k,l,a,n);  //...меняем строки местами,...
d:=d*(-1); //...определитедь умножается на -1,...
k1:=a[k,k]; //...определение значения ведущего элемента - k1,...
end
else
//В противном случае такой элемент отсутствует, что означает, что определитель системы равен нулю
begin
det:=0;
//выход из процедуры
exit;
end;
end;
if d<>0 then
//Вычитание из каждой i-ой строки, лежащей ниже k-ой,...
for i := k+1 to n do
begin
k2:=a[i,k];
k1:=a[k,k];
//...вычитание k-ой строки, умноженной на коэффициент
for j := k to  n+1  do
a[i,j] := a[i,j]-a[k,j]*k2/k1;
end;//цикл по i
d:=d*a[k,k];
end;//цикл по k
det:=d*a[n,n];
//Определитель системы равен произведению диагональных элементов
end;
function Minor(x,y:integer):matr;
var a : matr; n,i,j:integer;
begin
for i:=x to n do
for j:=1 to n do a[i,j]:=a[i+1,j];
dec(N); 
for j:=y to n do
 for i:=1 to N do
 a[i,j]:=a[i,j+1];
dec(n)
end;
procedure TForm1.Button1Click(Sender: TObject);
var i,j,i1,j1,n:integer; a,c:matr;
d:real;
begin
 n:=strtoint(edit1.Text);
 {Частный случай, взял как проверку
 d=10
 В итроге должно получиться:
   a[1,1]:=-5;
   a[2,1]:=1;
   a[3,1]:=4;
    a[1,2]:=15;
    a[2,2]:=3;
    a[3,2]:=-8;
     a[1,3]:=25;
     a[2,3]:=9;
     a[3,3]:=-14;
 или транспонированная
 итоговую матрицу надо умножить на (1/d)  }
    a[1,1]:=3;
    a[2,1]:=5;
    a[3,1]:=-2;
    a[1,2]:=1;
    a[2,2]:=-3;
    a[3,2]:=2;
    a[1,3]:=6;
    a[2,3]:=7;
    a[3,3]:=-3;
 for i1:=1 to n do
 for j1:=1 to n do
   begin
  // randomize;                      // общий случай; матрица nxn
  // a[i1,j1]:= random(7)+1;         // задается произвольно для n<=20
 //  b[i1,j1]:=a[i1,j1];
with stringgrid1 do
       begin
         Colcount:=n+1;
         Rowcount:=n+1;
         {cells[i1,0]:=inttostr(i);
         cells[0,j1]:=inttostr(j); }
         cells[i1,j1]:=floattostr(a[i1,j1]);
       end;
end;
determinant(a,n,d);
label1.Caption:=floattostrf(d,fffixed,4,1);
    c:=a;
begin
 for i:=1 to n do
 for j:=1 to n do
  begin
  c:= minor(1,2);   //вот здесь и запор
  determinant(c,n-1,d);     //детерминант от минора
  //союзная матрица, состоящая из детерминантов миноров *(1/determinant)
   stringgrid3.cells[i,j]:=floattostr((power((-1),(i+j)))*(1/d));
  end;
end;
end;
 
end.

а то ерундень получается.

[zetrix]

как минимум
function Minor(x,y:integer):matr;
var a : matr; n,i,j:integer;
begin
for i:=x to n do
for j:=1 to n do a[i,j]:=a[i+1,j];
dec(N); //- это удали
for j:=y to n do
for i:=1 to N do
a[i,j]:=a[i,j+1];
dec(n)
end;
это не верно, точнее не верно употреблять ДВАЖДЫ dec(n) (я-то писал для прямоугольной матрицы, а тут квадратная... Я так думаю ты так и не понял кода, что я привёл), надо только 1 раз, в конце!

[-=DeS=-]

Вот писал тоже:

Const N=100;
var i,m.temp : integer;
x:array[1..N] of integer;
BEGIN
Writeln ('Количество =', m);
for i:=1 to m do
begin
write('x[',i,']:=');
readln(A[i])
end;
for i:=1 to n div 2 do begin
begin
temp:=x[i];
x[i]:=x[m+1-i];
x[m+1-i]:=temp;
end;
for i:= to m do
Writeln('x[',i,']:=',x[i]);
end.

Писал пьяный могут быть косяки...

[Albenous]

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

Я так думаю ты так и не понял кода, что я привёл), надо только 1 раз, в конце!

Sorry, исправлял - забыл исправить.
Эта штука удаляет строку (столбец) и сдвигает массив в сторону.

Сообщение от -=DeS=-

for i:=1 to n div 2 do begin
begin 
temp:=x[i];
x[i]:=x[m+1-i];
x[m+1-i]:=temp;
end;

я не понял, это к чему? Поясни, пожалуйста текст, что имелось ввиду?

 
function Minor(x,y:integer):matr;
var a : matr; n,i,j:integer;
begin
for i:=x to n do
for j:=1 to n do 
a[i,j]:=a[i+1,j];//теперь стопорится здесь
 
for j:=y to n do
for i:=1 to N do
a[i,j]:=a[i,j+1];
dec(n)
end;

Все равно не получается. Помогите добить обратную матрицу.

[-=DeS=-]

Куда добавить? Напиши нормальное ТЗ

[Albenous]

если ТЗ - это задание, то оно такое: к матрице nxn где n - задается отдельно (3<n<21) написать программу, авчисляющую обратную матрицу. Все.
Могу добавить тем, кто забыл как вычисляется обратная матрица:
для начала создается союзная матрица. Затем каждый элемент союзной матрицы умножается на 1/определитель (детерминант) (в примере детерминант = 10 т.е. на 1/10)
Союзная матрица вычисляется так:
каждй элемент - определитель от минора этой же матрицы.
Процедура нахождения определителя есть, минора - написана zetrix`ом.
Теперь это все надо объединить, чтобы работало.

[pinhead]

program obraschenie;
 uses
    crt,modul;
 var
    CH:char;
    i,j,num,mat,n,iterations:byte;
    eps:extended;
    ishmatr,obr,rasshmatr:matrix;

 procedure error(s:string);
  begin
     write(s);
     readln;
     halt(0)
  end;

  procedure nach_dannye;
     begin
        writeln('‚室*лҐ ¤ **лҐ :');
        write('    а §¬Ґа*®бвм N -> ');
        readln(n);
        write('    в®з*®бвм  eps -> ');
        readln(eps);
        gotoxy(2,7+n);
        write('A -> ');
        gotoxy(8*n+13,7+n);
        for i:=1 to n do
           for j:=1 to n do
              begin
                 gotoxy(8*j+1,6+2*i);
                 read(ishmatr[i,j])
              end
     end;

    procedure ishod(nomer:byte);
     const
        nn:array[1..5]of byte=(2,2,3,4,3);
     begin
        case nomer of
           1 : begin
                  ishmatr[1,1]:=100;ishmatr[1,2]:=99;
                  ishmatr[2,1]:=99; ishmatr[2,2]:=98;
                  n:=nn[1]
               end;

           2 : begin
                  ishmatr[1,1]:=1;  ishmatr[1,2]:=10;
                  ishmatr[2,1]:=100;ishmatr[2,2]:=1001;
                  n:=nn[2]
               end;

           3 : begin
                  ishmatr[1,1]:=6;  ishmatr[1,2]:=13; ishmatr[1,3]:=-17;
                  ishmatr[2,1]:=13; ishmatr[2,2]:=29; ishmatr[2,3]:=-38;
                  ishmatr[3,1]:=-17;ishmatr[3,2]:=-38;ishmatr[3,3]:=50;
                  n:=nn[3]
               end;

           4 : begin
                  ishmatr[1,1]:=5; ishmatr[1,2]:=7; ishmatr[1,3]:=6; ishmatr[1,4]:=5;
                  ishmatr[2,1]:=7; ishmatr[2,2]:=10;ishmatr[2,3]:=8; ishmatr[2,4]:=7;
                  ishmatr[3,1]:=6; ishmatr[3,2]:=8; ishmatr[3,3]:=10;ishmatr[3,4]:=9;
                  ishmatr[4,1]:=5; ishmatr[4,2]:=7; ishmatr[4,3]:=9; ishmatr[4,4]:=10;
                  n:=nn[4]
               end;

           5 : begin
                  ishmatr[1,1]:=10; ishmatr[1,2]:=20; ishmatr[1,3]:=30;
                  ishmatr[2,1]:=12; ishmatr[2,2]:=42; ishmatr[2,3]:=45;
                  ishmatr[3,1]:=20; ishmatr[3,2]:=40; ishmatr[3,3]:=59.999999999;
                  n:=nn[5]
               end
        end
     end;

 procedure zapolnenie;
  begin
     rasshmatr:=ishmatr;
     for i:=1 to n do
        if num<>i then
           rasshmatr[i,N+1]:=0
        else
           rasshmatr[i,N+1]:=1
  end;

  procedure subtract_rows(var A:matrix;p,q:byte;x:extended);
   var
      t:byte;
   begin
      for t:=p+1 to n+1 do
         A[q,t]:=A[q,t]-x*A[p,t]
   end;

  procedure gauss;
   var
      p,q,k:byte;
   function partial_pivot(p:byte):byte;
    var
       t,q:byte;
       x,y:extended;
    begin
       q:=p;
       x:=abs(rasshmatr[p,p]);
       for t:=p+1 to n do
          begin
             y:=abs(rasshmatr[t,p]);
             if y>x then
                begin
                   q:=t;
                   x:=y
                end;
          end;
       partial_pivot:=q;
    end;
   procedure chang_rows(p,q:byte);
    var
       t:byte;
       x:extended;
    begin
       for t:=p to n+1 do
          begin
             x:=rasshmatr[p,t];
             rasshmatr[p,t]:=rasshmatr[q,t];
             rasshmatr[q,t]:=x
          end
    end;
   begin
      p:=1;
      repeat
         k:=partial_pivot(p);
         chang_rows(p,k);
         for q:=p+1 to n do
             subtract_rows(rasshmatr,p,q,rasshmatr[q,p]/rasshmatr[p,p]);
         inc(p);
      until(p>n)
   end;


  procedure obrXod;
   var
      t,k: byte;
      x:vector;
   begin
      for t:=n downto 1 do
         begin
        x[t]:=rasshmatr[t,n+1];
            for k:=n downto t+1 do
           x[t]:=x[t]-rasshmatr[t, k]*x[k];
        if (rasshmatr[t,t]<>0) then
               x[t]:=x[t]/rasshmatr[t, t]
        else
               begin
                  writeln('ЋЎа в*л© е®¤. „Ґ«Ґ*ЁҐ *  0.');
                  halt;
               end;
         end;
      for t:=1 to n do
         obr[t,num]:=x[t]
   end;

 procedure vyvod(D:matrix);
  begin
     for i:=1 to n do
        begin
           for j:=1 to n do
              write(D[i,j],'  ');
           writeln
        end
  end;

 procedure utochnenie;
  var
     E,D,norm:matrix;
  begin
     iterations:=0;
     Ematr(n,E);
     Multimatr(n,ishmatr,obr,norm);
     MultiMatrChislo(n,norm,-1,norm);
     SumMatr(n,e,norm,norm);
     writeln('Ќ®а¬  ¤® гв®з*Ґ*Ёп:  ',NormaMatrix(n,norm));
     while (NormaMatrix(n,norm)>=eps) do
        begin
           Multimatr(n,obr,norm,D);
           SumMatr(n,obr,D,obr);
           Multimatr(n,ishmatr,obr,norm);
           MultiMatrChislo(n,norm,-1,norm);
           SumMatr(n,e,norm,norm);
           inc(iterations)
        end;
     writeln('Ќ®а¬  Ї®б«Ґ гв®з*Ґ*Ёп:  ',NormaMatrix(n,norm));
     Multimatr(n,ishmatr,obr,norm);
     writeln('Ђ*Ђ-1:');
     vyvod(norm);
     writeln('?вҐа жЁ©:',iterations)
  end;

Смотри далее->>

[pinhead]

procedure MethodGauss;
begin
  for num:=1 to n do
    begin
      zapolnenie;
      gauss;
      obrXod;
    end;
  utochnenie;
  writeln('ЋЎа в* п ¬ ваЁж :');
  vyvod(obr)
end;
 
begin
    clrscr;
    gotoxy(30,1);
    textcolor(Cyan);
    writeln('ЋЎа йҐ*ЁҐ ¬ ваЁж');
    writeln;
    textcolor(LightGray);
    write('‚ў®¤ б Є« ўЁ вгал Ё«Ё *Ґв(Y/N) ');
    readln(CH);
    case CH of
       'Y','y':nach_dannye;
       'n','N':begin
                  write('‚ўҐ¤ЁвҐ *®¬Ґа бЁб⥬л (1..5)-> ');
                  readln(mat);
                  if (mat=1)or(mat=2)or(mat=3)or(mat=4)or(mat=5) then
                  else
                     error('’л зЁв вм *Ґг¬ҐҐим?');
                  write('‚ўҐ¤ЁвҐ в®з*®бвм->');
                  readln(eps);
                  ishod(mat);
               end
    else
       error('’л зЁв вм *Ґг¬ҐҐим?')
    end;
    MethodGauss;
    readkey
 end.

В DOS карявки превратятся в слова!!!
Модуль modul-смотри далее->>!!!