[ART]

Код:

type
 TMatrix = array of array of real;

procedure SwapCols(var M: TMatrix; i, j: Integer);
var
 k: integer;
 tmp: real;
begin
 for k := 0 to High(M[i]) do begin
  tmp := M[i][k];
  M[i][k] := M[j][k];
  M[j][k] := tmp;
 end;
end;

procedure SwapRows(var M: TMatrix; i, j: Integer);
var
 k: integer;
 tmp: real;
begin
 for k := 0 to High(M) do begin
  tmp := M[k][i];
  M[k][i] := M[k][j];
  M[k][j] := tmp;
 end;
end;

function IsZeroCol(M: TMatrix; n: Integer): Boolean;
var
 i: integer;
begin
 for i := 0 to High(M[n]) do
  if M[n][i] <> 0 then begin
   Result := false;
   Exit;
  end;
 Result := true;
end;

function IsZeroRow(M: TMatrix; n: Integer): Boolean;
var
 i: integer;
begin
 for i := 0 to High(M) do
  if M[i][n] <> 0 then begin
   Result := false;
   Exit;
  end;
 Result := true;
end;


procedure Compact(var M: TMatrix);
var
 r, c, w, h: integer;
 i, j: integer;
begin
 r := 0;
 for i := 0 to High(M) do
  if IsZeroRow(M, i) = True then r := r + 1;
 c := 0;
 for i := 0 to High(M[0]) do
  if IsZeroCol(M, i) = True then c := c + 1;

 h := r;
 w := c;

repeat
 for i := 0 to High(M) do
  if IsZeroRow(M, i) = True then
   for j := i to High(M) - 1 do SwapRows(M, j, j + 1);
 r := r - 1;
until r <= 0;

repeat
 for i := 0 to High(M[0]) do
  if IsZeroCol(M, i) = True then
   for j := i to High(M) - 1 do SwapCols(M, j, j + 1);
 c := c - 1;
until c <= 0;

 SetLength(M, Length(M[0]) - w, Length(M) - h);

end;