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

[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

[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 3:46