Обратная матрица, Неправильное вичисление Опции

[bembi]

написала программу, которая виполняет операции над матрицами и почему то обратную матрицу находит неверно. помогите найти ошыбку. вот процедурки для вычисления:

procedure inversm(var x,obr:matrix;err:boolean);
var y:matrix; i,j:integer;
procedure swaps(i,j:integer);
var k:integer; p:TM;
procedure swap(a,b:TM);
var c:TM;
begin c:=a; a:=b; b:=c end;
begin
for k:=1 to ng do begin swap(x[i,k],x[j,k]); swap(y[i,k],y[j,k]) end;
end;
procedure adds(i,j:integer;alpha:TM);
var k:integer;
begin
for k:=1 to ng do
begin x[i,k]:=x[i,k]+x[j,k]*alpha; y[i,k]:=y[i,k]+y[j,k]*alpha
end end;
procedure divs(i:integer;alpha:TM);
var k:integer;
begin
if alpha<>0 then
for k:=1 to ng do
begin
x[i,k]:=x[i,k]/alpha; y[i,k]:=y[i,k]/alpha end
end;
begin
for i:=1 to ng do
for j:=1 to ng do y[i,j]:=0;
for i:=1 to ng do y[i,i]:=1;
{початок основного методу}
for j:=1 to ng-1 do
begin
i:=j;
while x[i,j]=0 do i:=i+1;
if i>ng then begin err:=true; end;
swaps(j,i);
for i:=j+1 to ng do begin if x[j,j]=0 then err:=true else
adds(i,j,-x[i,j]/x[j,j]); end;
end;
if x[ng,ng]=0 then begin err:=true; end;
for i:=1 to ng do divs(i,x[i,i]);
for i:=ng downto 2 do
for j:=i-1 downto 1 do adds(j,i,-x[j,i]);
{сформульована обернена}
obr:=y;
end;
procedure readm(var x:matrix);
var i,j,ti:integer;
begin repeat text1(bbb);
rx:=4; ry:=4; rz:=1;
readword2(rr,rx,ry,rz); ti:=rr; clrscr;
if (ti=1) then begin textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
for i:=1 to ng do begin
for j:=1 to ng do begin textcolor(lightgreen); write('Enter elements of matrix',i,'_',j,': ');
rx:=4; ry:=3; rz:=3;
readword2(rr,rx,ry,rz); x[i,j]:=rr; clrscr; textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
end; end; end;
if (ti=2) then begin
randomize;
for i:=1 to ng do begin
for j:=1 to ng do begin x[i,j]:=random(20); end; end; end;
until (ti>=1) and (ti<=2); clrscr; textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
textcolor(lightgreen); writeln('Start matrix:');
for i:=1 to ng do begin gotoxy(4,2+i); textcolor(white);
for j:=1 to ng do write(x[i,j]:8:2); writeln; end;
end;
procedure writem(var x:matrix);
var i,j:integer;
begin writeln; gotoxy(4,6+2*ng); textcolor(lightgreen); writeln('Inverse matrix:');
for i:=1 to ng do
begin gotoxy(4,6+2*ng+i);textcolor(lightc yan);
for j:=1 to ng do write(x[i,j]:8:2,' ');
writeln; end;
end;

Ето вывод в case:
2

: begin {Обернена матриця}
Repeat textbackground(black); clrscr; textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2); textcolor(lightgreen);
write('Enter degree of matrix: '); rx:=4; ry:=3; rz:=1; readword2(rr,rx,ry,rz); ng:=rr; gotoxy(4,5);
if (ng<=1) or (ng>5) then writeln('Error!!!') else begin
begin
readm(x); inversm(x,y,err);
end;
for ir:=1 to ng do
for jr:=1 to ng do begin
z[ir,jr] := 0;
for i:= 1 to ng do
{Підсумкова формула}
z[ir,jr] :=z[ir,jr] + x[ir,i] * x[i,jr];
end;
begin
writeln; gotoxy(4,4+ng); textcolor(yellow); writeln('Checking: it must be unitary matrix.'); textcolor(lightcyan);
for ir:=1 to ng do begin gotoxy(4,4+ng+ir);
for jr:=1 to ng do
Write(z[ir,jr]:8:2); WriteLn; end;
end;
writeln; textcolor(lightgreen);
for ir:=1 to ng do
for jr:=1 to ng do begin
if ((ir=jr) and (z[ir,jr]<>1)) or ((ir<>jr) and (z[ir,jr]<>0)) then
l1:=1; end; gotoxy(4,10+2*ng);textcolor(lightre d);
if (l1=1) then writeln('Inverse matrix not exist!')
else writem(y);
end; text(bbb);
ch:=readkey;
if ch=#0 then ch:=readkey;
until ch=#27;
end;

Если нужно, могу скинуть весь исходник.

Сообщение отредактировано: Lapp - 23.03.2011 11:08

[Shmaniche]

Очень необходима помощь! Помогите найти ошибку в этой программе, второй день найти не могу:

program OBRMAT;
uses crt;
const c=4;
      t=0.00001; {Ограничиваем числа бликие к нулю}
type Tmatr=array [1..c, 1..c] of real;

{Процедура переустановки строк, чтобы главный элемент не оказался 0 или
 близким к 0 значением}
procedure Per(k,n:integer; var a:Tmatr; var p:integer);
var i, j:integer;
       z:real;
begin
   z:=abs(a[k,k]); {После...}
   i:=k; {каждого...}
   p:=0; {преобразования...}
   for j:=k+1 to n do  {ищем по оставшимся строкам...}
     begin
       if abs(a[j,k])>z then {максимальный по модулю элемент}
        begin
          z:=abs(a[j,k]); {Запоминаем...}
          i:=j;  {номер строки}
          p:=p+1; {Считаем кол-во переустановок, т.к. в каждой...}
                  {переустановке меняется знак определителя}
         end;
     end;
   if i>k then  {Если эта строка ниже данной}
   for j:=k to n do
     begin
       z:=a[i,j]; {тогда}
       a[i,j]:=a[k,j]; {делаем}
       a[k,j]:=z; {переустановку}
     end;
end;

{Изменение знака при переустановке строк матрицы}
function Znak(p:integer):integer;
 begin
  if p mod 2=0 then {Если четное кол-во переустановок...}
  znak:=1 {"+",}
  else Znak:=-1; {если нет, то "-"}
 end;

{Изменение знака при переустановке строк при нахождении дополнений}
function Znak1(i,m:integer):integer;
 begin
  if (i+m) mod 2=0 then
  Znak1:=1
  else Znak1:=-1;
 end;

{Процедура вычисления определителя матрицы}
procedure Opr(n, p:integer; var a:Tmatr; var det:real; var f:byte);
var k, i, j:integer;
    delenie:real;
begin
 det:=1.0;
 f:=0;
  for k:=1 to n do
   begin
    if a[k,k]=0 then {Если главный элемент = 0,}
       Per(k,n,a,p); {делаем переустановку}
       det:=Znak(p) * det * a[k,k]; {Меняем знак определителя}
    if abs(det)<t then {Если модуль определителя меньше константы...}
     begin
      f:=1;
      writeln ('Обратной матрицы нет!'); {выводим, что обр матрицы нет}
      readln;
      exit;
     end;
    for j:=k+1 to n do  {Ниже делаем преобразования}
     begin
      delenie:=a[j,k] / a[k,k];
       for i:=k to n do
        begin
         a[j,i]:=a[j,i] - delenie * a[k,i];
        end;
     end;
   end;
end;

{Процедура вычисления определителей-дополнений}
procedure Opr1(n, p:integer; d:Tmatr; var det1:real);
var k, i, j:integer;
    delenie:real;
begin
 det1:=1.0;
  for k:=2 to n do
   begin
    if d[k,k]=0 then {Если главный элемент = 0,}
       Per(k,n,d,p); {делаем переустановку}
    for j:=k+1 to n do  {Ниже делаем преобразования}
     begin
      delenie:=d[j,k] / d[k,k];
       for i:=k to n do
         d[j,i]:=d[j,i] - delenie * d[k,i];
     end;
   end;
end;

{Процедура вычисления дополнений}
procedure Peresch(n,p:integer; var b:Tmatr; det1:real; var e:Tmatr);
var i,m,k,j:integer;
    z:real;
    d,c:Tmatr;
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 Transp(a:Tmatr; n:integer; var at:Tmatr);
 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 Vyvod (var a: Tmatr; n:integer);
var k,j:integer;
 begin
  for k:=1 to n do
   begin
    for j:=1 to n do
     write (a[k,j]:5:3,' ':2); {Вывод матрицы с отступами}
     writeln;
   end;
 end;

{Основная программа}
var n,k,j,i,p:integer; {n - размер матрицы, k - счетчик по строкам,}
                       {j - счетчик по столбцам, p - счетчик переустановок}
    a,at,b,e:Tmatr; {a - исходная матрица, at - транспонированная,}
                    {b - матрица дополнений, e - обратная матрица}
    det,det1:real; {det - определитель исх. матрицы, det1 - определители-дополнения}
    f:byte; {признак несуществования обратной матрицы}

begin
 clrscr;
 writeln('Вычислить определитель матрицы (Только для квадратной матрицы) и обратную матрицу.');
 writeln;

 writeln('Введите кол-во элементов в строке матрицы и нажмите ENTER');
 writeln('(Число элементов в строке будет равно числу элементов в столбце!):');
 readln(n);

 writeln;
 writeln('Вводите коэфф-ты матpицы A по стpокам нажимая ENTER:');
  for k:=1 to n do
   for j:=1 to n do
       begin
        write ('a[',k,',',j,']=');
        read(a[k,j]);
   end;
  writeln;

 writeln('Исходная матрица:');
 Vyvod (a,n);
 writeln;

 Opr(n,p,a,det,f); {Вычисление определителя}
 if f=1 then exit; {Если обратной матрицы не существует,}
                   {то завершить программу}
 write('Определитель = ',det:2:0, '.');
 writeln;

 if f=1 then exit;
 Transp (a,n,b);
 Peresch(n,p,b,det1,e);
 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;

 readkey;

end.

Определитель вычисляет правильно, а вот обратную матрицу нет .
Когда вводишь матрицу:
1 2
3 4

Выводится:
-0,5 0,5
0,5 -0,5

А должно быть:
-2 1
1.5 -0.5
Что и где пропущено?

Сообщение отредактировано: Shmaniche - 10.04.2013 9:22