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

[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 15:08

[Lapp]

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

Даа... bembi, ты просто гигант мысли. В ТАКОМ разобраться - это надо самому быть компьютером..

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

[TarasBer]

Мне хватило этой строчки.

for j:=1 to ng do write(x[i,j]:8:2); writeln; end;

где тот бегин, к которому относится этот енд? Я когда так пишу в 1 строчку, то бегин и енд на одной строке.

[volvo]

почему то обратную матрицу находит неверно

Неправда. Все верно находит. Проверил на матрице

const
   x : matrix = (
     (1, 2, 3, 0, 0),
     (3, 4, 2, 0, 0),
     (9, 8, 2, 0, 0),
     (0, 0, 0, 0, 0),
     (0, 0, 0, 0, 0)
   );

при ng = 3, в результате после вызова inversm матрица Y приняла вид:

   0.40  -1.00   0.40
  -0.60   1.25  -0.35
   0.60  -0.50   0.10

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

P.S. Все-таки, третий параметр inversm неплохо было бы описать как Var, чтоб в случае ошибки это можно было определить снаружи, в основной программе.

[bembi]

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

вот исходник, посмотрите пожалуйста что там не так... (Показать/Скрыть)

Program M_Operations;
Uses CRT;
 const por=10;
 type  TM=real;
    vec=array[1..10] of real; mas=array[1..10] of vec;
    matrix=array[1..por,1..por] of TM; matr=array[1..por,1..por] of longint;

var aq,bq:matr;   
 x,y,z:matrix; 
i,j,ir,jr:integer; 
err:boolean; 
ik,ji,dt,ng:longint;  
l1:integer; 
sa:mas;sb,sx:vec;
sh:real; 
si,sj,sk,sn:integer;
xx,yy,zz,ii:integer;
bbb,texmenu:string; 
rr:word; 
rx,ry,rz:byte;
Procedure Frame(xx1,yy1,xx2,yy2:integer);
var xI:integer;
begin
xx1:=2; yy1:=1; xx2:=79; yy2:=25;
   for xi:=xx1 to xx2-1 do
   begin
    GotoXY(xi,yy1); write('*'); 
    GotoXY(xi,yy2); write('*');
   end;
   for xi:=yy1 to yy2 do
   begin
    GotoXY(xx1,xi); write('*'); 
    GotoXY(xx2,xi); write('*');
   end;
    GotoXY(xx1,yy1); write('*');
    GotoXY(xx2,yy1); write('*');
    GotoXY(xx1,yy2); write('*');
    GotoXY(xx2,yy2);  write('*');
end;

Procedure ReadWord2(Var Result : Word; x, y, MaxLength : byte);
Const
  Symbol : set of char=['0'..'9',#8,#13];
Var
  Str : string; Code : integer; Key : char;
Begin
  GoToXY(x,y);{курсор - в задану позицію}
  Str := ''; {стрічка пуста}
  repeat {початок безкінечного циклу}
    {перевірка введених символів на допустимість}
    repeat
      Key := ReadKey
    until Key in Symbol;
    case Key of {аналіз введених символів}
      '0'..'9' : {натиснута цифра}
        if Length(Str)>=MaxLength {якщо довжина більша за задану}
          then begin
              Sound(100); {звуковий сигнал}
              Delay(200); NoSound;
            end
          else {якщо довжина менша за задану}
            begin write(Key);
              Str:=Str+Key; {додавання символа в стрічку}
            end;
      #8 : {натиснута клавіша BackSpace}
        if Length(Str)>0 {якщо стрічка не пуста}
          then begin
              Delete(Str, Length(Str),1); {видалення зі стрічки}
              GoToXY(WhereX-1, WhereY); {повернення курсора}
              write(' '); {запис пробіла замість символа }
              GoToXY(WhereX-1, WhereY); {повернення курсора}
            end
          else {якщо стрічка пуста}
            begin
              Sound(100); {звуковий сигнал}
              Delay(200); NoSound;
            end;
      #13 : {натиснута клавіша Enter}
        begin
          Val(Str, Result, Code); {перетворення стрічки в ціле число}
          Exit 
        end;
      end; {кінець оператора Case}
  until False; {безкінечний цикл}
End;

procedure menu(var tex:string);
begin
clrscr;  textcolor(lightblue); Frame(xx,yy,zz,ii); textcolor(green); gotoxy(25,3);
writeln('MATRIX OPERATIONS'); textcolor(lightred); gotoxy(20,5); WriteLn ('Make a choice:');writeln;
gotoxy(20,9); textcolor(yellow);      WriteLn ('1 - find the determinant of matrix');
gotoxy(20,10); textcolor(yellow);     WriteLn ('2 - find inverse matrix');
gotoxy(20,11); textcolor(yellow);   WriteLn ('3 - transpose matrix');
gotoxy(20,12); textcolor(yellow);      WriteLn ('4 - add matrix');
gotoxy(20,13); textcolor(yellow);      WriteLn ('5 - sub matrix');
gotoxy(20,14); textcolor(yellow);  WriteLn ('6 - multiply matrix');
gotoxy(20,17); textcolor(white);   Writeln ('7 - exit'); textcolor(black);  writeln;
end;

 procedure text(aaa:string);
 begin   
 textcolor(cyan); writeln; gotoxy(4,23);  
 Writeln('Press key ESC to return in a menu');
 gotoxy(4,24);     Writeln('Press any key to execute action one more');
end;

 procedure text1(aaa:string);
 begin
  clrscr;   textcolor(lightblue); 
Frame(xx,yy,zz,ii); 
textcolor(lightgreen); gotoxy(4,2); writeln('1 - enter yours value of elements');
textcolor(lightgreen); gotoxy(4,3); writeln('2 - choose random value of elements');
end;

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(lightcyan);
 for j:=1 to ng do  
 write(x[i,j]:8 :2,' ');
 writeln; 
 end;
end;

procedure GetMatr(aq:matr; var bq:matr; m,i,j:integer);
var ki,kj,di,dj:integer;
 begin 
 di:=0;
 for ki:=1 to m-1 do
   begin
   if (ki=i) then di:=1;
   dj:=0;
   for kj:=1 to m-1 do
     begin
     if (kj=j) then
        dj:=1; 
        bq[ki,kj]:=aq[ki+di,kj+dj]; 
     end; 
  end;
 end;
Function Determinant(aq:matr;ng:integer):longint;
var ik,ji,d,k:longint; bq:matr;
 begin 
 d:=0; k:=1;
 if (ng<1) then
   begin
   writeln('Error!!! N=',ng); halt;
   end;
 if (ng=1)
   then d:=aq[1,1]
 else if (ng=2)
   then d:=aq[1,1]*aq[2,2]-aq[2,1]*aq[1,2]
 else { ng>2 }
   for ik:=1 to ng do
     begin GetMatr(aq,bq,ng,ik,1); d:=d+k*aq[ik,1]*Determinant(bq,ng-1); k:=-k;end;
 Determinant:=d;
 end;

VAR i1, i2, i3, i4 : integer;  {лічильник стрічок}
    j1, j2, j3, j4 : integer;  {лічильник стовпців}
    operation: integer;    {варіант розвитку програми}
    det :      real;       {визначник} 
k,tip,osh:integer;    ch,kl:char;
{робоча змінна}

    {Масиви (матриці), які використовуються в програмі}
    MAS1,   {Матриця А}
    MAS2,   {Матриця В}
    MAS3,     {Матриця С}
    MAS4 : array [1..10,1..10] of real;
  m1,m2,m3,m4,n1,n2,n3,n4:integer;
BEGIN   repeat
textbackground(black);
clrscr;
textcolor(lightblue);
Frame(xx,yy,zz,ii);
textcolor(red);
   menu(texmenu);        
 rx:=4; ry:=18; rz:=1;
 readword2(rr,rx,ry,rz); 
operation:=rr; {Занесення вибраного варіанта в память}

          Case operation of  {Оператор вибору}
              1: 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:=2;
 readword2(rr,rx,ry,rz); 
ng:=rr; 
gotoxy(4,5);
if (ng<=0) or (ng>10) then  writeln('Error!!!')
else 
begin
repeat text1(bbb);
     rx:=4; 
     ry:=4; 
     rz:=1;
     readword2(rr,rx,ry,rz);
     tip:=rr;
 clrscr;
if (tip=1) then
 begin 
 textcolor(lightblue);  Frame(xx,yy,zz,ii);   gotoxy(4,2);
 for ik:=1 to ng do 
 begin
  for ji:=1 to ng do 
   begin 
    textcolor(lightgreen);
    write('Enter elements of matrix ',ik,'_',ji,': ');    
    rx:=4; ry:=3; rz:=3;
    readword2(rr,rx,ry,rz); 
    aq[ik,ji]:=rr; 
    clrscr;  
   textcolor(lightblue); Frame(xx,yy,zz,ii);   gotoxy(4,2); 
  end; 
 end; 
end;
if (tip=2)  then 
begin 
textcolor(lightblue); Frame(xx,yy,zz,ii);
randomize;
for ik:=1 to ng do 
begin
 for ji:=1 to ng do 
 begin
  aq[ik,ji]:=random(20);  
 end;  
end;
end;
until  (tip>=1) and (tip<=2);
 clrscr;
 textcolor(lightblue); Frame(xx,yy,zz,ii);
 textcolor(lightgreen);
dt:=Determinant(aq,ng);
gotoxy(4,ng); 
writeln('Matrix:');
 for ik:=1 to ng do
 begin 
  textcolor(white); gotoxy(4,ng+ik);
  for ji:=1 to ng do 
   begin
    write(aq[ik,ji]:8); 
   end;
   writeln; 
 end; 
gotoxy(4,ng+ik+2); 
gotoxy(4,8+ng); 
textcolor(lightcyan);
writeln('Determinant=',dt);
end;
               text(bbb);
         ch:=readkey;
      if ch=#0 then ch:=readkey;
      until ch=#27;               
end;

              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(lightred);
              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;

              3: begin {Транспонування матриці}
              repeat
              textbackground(black);
                 clrscr;  
  textcolor(lightblue); Frame(xx,yy,zz,ii);  gotoxy(4,2);
 textcolor(lightgreen); 
Write ('Enter count of rows of initial matrix, not more then 9: '); 
rx:=4; 
ry:=3; 
rz:=1; 
readword2(rr,rx,ry,rz); 
m1:=rr;
 gotoxy(4,4); textcolor(lightgreen); 
Write ('Enter count of columns of initial matrix, not more then 9: '); 
rx:=4; 
ry:=5; 
rz:=1; 
readword2(rr,rx,ry,rz);
n1:=rr; gotoxy(4,7);
      If (1>n1) or  (n1>10) or (1>m1) or  (m1>10) {Умови помилки}
        Then WriteLn ('Error!!!')
               else    begin 
                repeat  
                  text1(bbb); 
                  rx:=4; ry:=4; rz:=1; 
                  readword2(rr,rx,ry,rz); 
                  tip:=rr; 
                  clrscr;
if (tip=1) then begin
                    for i1:=1 to m1 do begin
                    for j1:=1 to n1 do begin 
                    clrscr;
                   textcolor(lightblue); Frame(xx,yy,zz,ii);  gotoxy(4,2); 
                   textcolor(lightgreen); 
                   write('Enter elements of matrix',i1,'_',j1,': '); 
                   rx:=4; ry:=3; rz:=3;
                   readword2(rr,rx,ry,rz); 
                   MAS1[i1,j1]:=rr; 
                   end; 
                   end;
end;
         if (tip=2)  then begin
randomize;
for i1:=1 to m1 do begin
for j1:=1 to n1 do begin
MAS1[i1,j1]:=random(20);  
end; 
end; 
        end;
until  (tip>=1) and (tip<=2);
                 writeln; 
                 begin 
                 clrscr; 
                 textcolor(lightblue); Frame(xx,yy,zz,ii);  
                 textcolor(lightgreen);  gotoxy(4,2); 
                 writeln('Start matrix:'); 
                 textcolor(white);
                  for i1:=1 to m1 do begin    
                  gotoxy(4,2+i1);
                  for j1:=1 to n1 do  
                  write(MAS1[i1,j1]:4 :0,' '); 
                  writeln;  
                  end; 
       writeln;
 textcolor(lightgreen); gotoxy(4,4+m1);
 writeln('Transpose matrix: '); 
 textcolor(lightcyan);
                    for i1:=1 to n1 do begin 
                    gotoxy(4,4+m1+i1);
                    for j1:=1 to m1 do
                    write(MAS1[j1,i1]:4 :0,' ');
                    writeln;  
                    end; 
end;  
end;  
text(bbb); 
ch:=readkey;
      if ch=#0 then ch:=readkey;
      until ch=#27;
              end;

              4,5: begin {Додавання/віднімання матриць}
              Repeat 
   textbackground(black); 
   clrscr; 
   textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
   textcolor(lightgreen); Write ('Enter count of rows first and second matrix: '); 
   rx:=4; ry:=3; rz:=1;
   readword2(rr,rx,ry,rz); 
   m1:=rr;   
   gotoxy(4,4); textcolor(lightgreen); 
   Write ('Enter count of columns first and second matrix: '); 
   rx:=4; ry:=5; rz:=1;
   readword2(rr,rx,ry,rz); 
   n1:=rr;    
   gotoxy(4,7);
                       if (m1<1) or (n1<1) or (m1>5) or (n1>5)  then
                       writeln('Error!!!') 
                       else begin
                                  repeat  text1(bbb);
                                  rx:=4; ry:=4; rz:=1;
                                  readword2(rr,rx,ry,rz); 
                                  tip:=rr;  
                                  clrscr;
if (tip=1) then begin
           for i1:=1 to m1 do begin
          for j1:=1 to n1 do begin 
          clrscr; 
          textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2); 
          textcolor(lightgreen); 
          Write('Enter elements of matrix A ',i1,'_',j1,': '); rx:=4; ry:=3; rz:=3; 
          readword2(rr,rx,ry,rz); 
          MAS1[i1,j1]:=rr; 
          end; 
           end; 
writeln;
                                 for i1:=1 to m1 do begin
                                   for j1:=1 to n1 do begin 
clrscr; 
textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2); 
textcolor(lightgreen); Write('Enter elements of matrix B ',i1,'_',j1,': '); 
rx:=4; ry:=3; rz:=3;
readword2(rr,rx,ry,rz); 
MAS2[i1,j1]:=rr; 
end;
end;   
end;
                   if (tip=2)  then begin
randomize;
for i1:=1 to m1 do begin
for j1:=1 to n1 do begin
MAS1[i1,j1]:=random(20);
MAS2[i1,j1]:=random(20);  
end; 
end; 
end;
until  (tip>=1) and (tip<=2); 
clrscr; 
 textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
 textcolor(lightgreen); writeln('Matrix A:');
                           for i1:=1 to m1 do   {Виведення першої матриці}
                           begin                  
                             gotoxy(4,i1+2);
                             for j1:=1 to n1 do
                             Write(MAS1[i1,j1]:8 :2); 
                             WriteLn; 
                           end;
                            writeln;  
                            gotoxy(4,m1+4); textcolor(lightgreen); 
                            Writeln('Matrix B:');
                        for i1:=1 to m1 do   {Виведення другої матриці}
                           begin
                             gotoxy(4,m1+4+i1);
                             for j1:=1 to n1 do
                             Write (MAS2[i1,j1]:8 :2); 
                             WriteLn; 
                           end;
                           writeln;    
                           textcolor(lightcyan); 
                           if operation = 4 then begin k:=1;   
                           gotoxy(4,2*m1+6); 
                           writeln('Result A+B:'); 
                          end;
                       if operation = 5 then begin k:=-1;
                       gotoxy(4,2*m1+6); 
                       writeln('Result A-B:'); 
                       end;
                       for i1:=1 to m1 do
                          for j1:=1 to n1 do
                            MAS3[i1,j1]:=MAS1[i1,j1]+k*MAS2[i1,j1];
                       {Підсумкова формула}
                       for i1:=1 to m1 do
                           begin         
                            gotoxy(4,2*m1+6+i1); 
                            for j1:=1 to n1 do  
                            Write(MAS3[i1,j1]:8 :2); 
                            WriteLn; 
                           end;   
                        end;  
                        text(bbb);    
                        ch:=readkey;
      if ch=#0 then 
      ch:=readkey; 
      until ch=#27;
          end;

              6:  begin {Множення матриць}
              repeat
              textbackground(black); 
clrscr; 
textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2);
 textcolor(lightgreen); Write ('Enter count of rows first matrix: '); rx:=4; ry:=3; rz:=1;
readword2(rr,rx,ry,rz); m1:=rr;     gotoxy(4,4); textcolor(lightgreen); Write ('Enter count of columns first matrix: ');
rx:=4; ry:=5; rz:=1;
readword2(rr,rx,ry,rz);
n1:=rr;
gotoxy(4,6);textcolor(lightgreen); 
Write ('Enter count of rows second matrix: ');
rx:=4; ry:=7; rz:=1;
readword2(rr,rx,ry,rz); 
m2:=rr;  
gotoxy(4,8);textcolor(lightgreen);
Write ('Enter count of columns second matrix: '); 
rx:=4; ry:=9; rz:=1;
readword2(rr,rx,ry,rz); 
n2:=rr;   
gotoxy(4,11); 
If (1>m2) or  (m2>5) or (1>n2) or  (n2>5) or (1>m1)
{Умова помилки}
          or (m1>5) or (1>n1) or (n1>5)  or  (n2<>m1) or (n1<>m2) then
                    WriteLn('Error!!!')
                       else
                       begin
                       repeat  text1(bbb); 
                       rx:=4; ry:=4; rz:=1; 
                       readword2(rr,rx,ry,rz); 
                       tip:=rr;
if (tip=1) then begin
                                  for i1:=1 to m1 do begin
                                   for j1:=1 to n1 do begin
                                   clrscr; 
                                   Frame(xx,yy,zz,ii); gotoxy(4,2); textcolor(lightgreen); 
                                   Write('Enter elements of matrix A ',i1,'_',j1,': ');
                                   rx:=4; ry:=3; rz:=3; 
                                   readword2(rr,rx,ry,rz); 
                                   MAS1[i1,j1]:=rr; 
                                   end; 
                                 end;   
                                 writeln;
                                 for i2:=1 to m2 do begin
                                   for j2:=1 to n2 do begin
                                   clrscr;
textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2); 
textcolor(lightgreen); Write('Enter elements of matrix B ',i2,'_',j2,': '); 
rx:=4; ry:=3; rz:=3; 
readword2(rr,rx,ry,rz); 
MAS2[i2,j2]:=rr; 
end; 
end;  
end;
                     if (tip=2)  then begin
randomize;
for i1:=1 to m1 do begin
for j1:=1 to n1 do begin
MAS1[i1,j1]:=random(20);
  end; 
end;
   for i2:=1 to m2 do begin
   for j2:=1 to n2 do begin
   MAS2[i2,j2]:=random(20); 
   end; 
   end;
  end;
until  (tip>=1) and (tip<=2);
                   clrscr;   
textcolor(lightblue); Frame(xx,yy,zz,ii); gotoxy(4,2); 
textcolor(lightgreen); writeln('Matrix A:');
                           for i1:=1 to m1 do   {Виведення першої матриці}
                           begin  
                             textcolor(white);   
                             gotoxy(4,2+i1);
                             for j1:=1 to n1 do
                             Write(MAS1[i1,j1]:5 :0);
                             WriteLn;
                           end;
                            writeln; 
                          gotoxy(4,4+i1); textcolor(lightgreen);
                          Writeln('Matrix B:');
                        for i2:=1 to m2 do   {Виведення другої матриці}
                           begin 
                             textcolor(white); gotoxy(4,4+m1+i2);
                             for j2:=1 to n2 do                
                             Write (MAS2[i2,j2]:5 :0); WriteLn;
                           end;
                    m3:=m1; n3:=n2;
                    for i3:=1 to m3 do
                        for j3:=1 to n3 do begin
                                             MAS3[i3,j3] := 0;
                                             for i2:= 1 to m2 do
                                  {Підсумкова формула}
MAS3[i3,j3] :=MAS3[i3,j3] + MAS1[i3,i2] * MAS2[i2,j3];
                                           end;
                    begin {Виведення множення}     textcolor(lightcyan);
                      writeln;      
                      gotoxy(4,6+m1+m2);
                      writeln('Result A*B:');
                      for i3:=1 to m1 do begin 
                     gotoxy(4,6+m1+m2+i3);
                     for j3:=1 to n2 do 
                     Write(MAS3[i3,j3]:7 :0); WriteLn;
                     end;
                    end;
                m4:=m2; n4:=n1;
                for i4:=1 to m4 do
                        for j4:=1 to n4 do begin
                                             MAS4[i4,j4] := 0;
                                             for i1:= 1 to m1 do
                                  {Підсумкова формула}
MAS4[i4,j4] :=MAS4[i4,j4] + MAS2[i4,i1] * MAS1[i1,j4];
                                           end;
                    begin {Виведення множення} 
                      writeln;  { gotoxy(4,9+2*m1+m2);} 
                      gotoxy(20+2*n2+2*m1,6+m1+m2); 
                      textcolor(lightcyan);writeln('Result B*A:');
                      for i4:=1 to m2 do begin    {gotoxy(4,9+2*m1+m2+i4);} 
                      gotoxy(20+2*n2+2*m1,6+m1+m2+i4);
                     for j4:=1 to n1 do 
                     Write(MAS4[i4,j4]:7 :0);WriteLn;
                     end;
                   end; 
end;     
textcolor(blue);  
text(bbb); 
ch:=readkey;
      if ch=#0 then ch:=readkey;
      until ch=#27;    end;

7:  exit
          End; {End Case}
   until    kl=#27;
          ReadKey;
END.

Убрал исходник под спойлер, там все-таки 750 строк...

Сообщение отредактировано: volvo - 27.03.2011 7:46

[volvo]

Ты не хочешь меня слушать? Я ж говорю: матрица вычисляется правильно. То есть, (см. на строки 365-370)

 if (ng<=1) or (ng>5) then writeln('Error!!!')  { Это строка 365 }
 else begin
 begin
  readm(x); 
  inversm(x,y,err); { <--- Всё, обратная матрица УЖЕ НАЙДЕНА }
 end;

Все, что ты делаешь дальше - это не нужно. Обратная матрица УЖЕ находится в переменной Y. Просто сразу печатай ее. Сразу после Inversm добавь вызов процедуры Writem(Y), а строки с 371 до 404 можешь вообще закомментировать или убрать, они не нужны. Там ты производишь никому не нужную и к тому же неправильную последовательность действий. Зачем делать второй раз то, что уже сделано?

[вова]

так чо програмка працює?????

[Shmanich]

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

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 13:22