Удаление нулевых строк и столбцов Опции

[Seoron]

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

[volvo]

Что значит "удалит"? Если матрица не динамическая, то из нее в принципе ничего удалить нельзя. Можно сделать какие-то махинации с переносом столбцов на один левее/строк - на одну выше, или можно пропустить при выводе. И тот и другой вариант уже рассматривался прямо на этому форуме. Ищи, делай свою программу, что будет непонятно - спросишь.

[Seoron]

Ой я немного не так написал, в задаче вобще написано уплотните квадратную матрицу влево и вверх, для выявления нулевы строк и столбцов используйте подпрограмму.
Я вот написал прогу только вот что-то не работает

Program Zadanie_6;
Uses crt;
const n=4; m=4;
type matr=array[1..n,1..m] of real;
var n1,m1,i,j,i1,j1,k:integer; a:matr;

procedure DelStroka(var a:matr; d:integer);
var
  i: integer;
begin
  for i:=d to n-1 do a[i]:=a[i+1]
end;

procedure DelStolbec(var a:matr; p:integer);
var
  i,j:integer;
begin
  for i:=1 to n1 do for j:=p to n-1 do a[i,j]:=a[i,j+1]
end;


	procedure poisk_stolbca;
	Begin
	for j:=1 to m1 do begin
	k:=0;
	for i:=1 to n1 do
	if a[i,j]=0 then k:=k+1;
	if k=n1 then 
	i1:=i; 
	end;
	end;
	procedure ppoisk_stroki;
	Begin
	for i:=1 to n1 do begin
	k:=0;
	for j:=1 to m1 do
	if a[i,j]=0 then k:=k+1
	if k=m1 then 
	j1:=j; 
	end;
	end;

Begin clrscr;
n1:=n; m1:=m;
Writeln('Введите матрицу ',n,'x',m);
for i:=1 to n1 do
for j:=1 to m1 do begin
readln(a[i,j]);
end;
poisk_stolbca;ppoisk_stroki;
if i1>0 then begin 
DelStolbec(a,i1); dec(m1);end;
if j1>0 then begin
DelStroka(a,j1); dec(n1);end;
Writeln('Новая матрица');
for i:=1 to n1 do
for j:=1 to m1 do begin
writeln(a[i,j]:5);
end;
readke 

Сообщение отредактировано: Seoron - 17.11.2010 22:55

[Гость]

А почему он удаляет только одну плохую строку/столбец?

[Seoron]

Всё, сделал, можите удалить тему или оставить комуто на будующее. вот рабочяя программа

Program Zadanie_6;
Uses crt;
const n=4; m=4;
type matr=array[1..n,1..m] of integer;
var n1,m1,i,j,i1,j1,k,t:integer; a:matr; f:boolean;

procedure DelStroka(var a:matr; d:integer);
var
  i: integer;
begin
  for i:=d to n1-1 do
  for j:=1 to m1 do begin
   a[i,j]:=a[i+1,j];
   end;
end;

procedure DelStolbec(var a:matr; p:integer);
var
  i,j:integer;
begin
  for i:=1 to n1 do for j:=p to n1-1 do a[i,j]:=a[i,j+1]
end;


	procedure poisk_stolbca;
	Begin
	for j:=1 to m1 do begin
	k:=0;
	for i:=1 to n1 do
	if a[i,j]=0 then k:=k+1;
	if k=n1 then 
	j1:=j;
	end;
	end;
	procedure ppoisk_stroki;
	Begin
	for i:=1 to n1 do begin
	k:=0;
	for j:=1 to m1 do
	if a[i,j]=0 then k:=k+1;
	if k=m1 then 
	i1:=i;
	end;
	end;

Begin clrscr;  randomize;
n1:=n; m1:=m;  f:=false;
Writeln('Введите матрицу ',n,'x',m);
for i:=1 to n1 do
for j:=1 to m1 do begin
readln(a[i,j]);
end;  clrscr;
Writeln('Исходная матрица:');
for i:=1 to n do begin
for j:=1 to m do
write(a[i,j]:5);
writeln;
end;
repeat
i1:=0;j1:=0;
poisk_stolbca;ppoisk_stroki;
if i1>0 then begin 
DelStolbec(a,i1); dec(m1);end;
if j1>0 then begin
DelStroka(a,j1); dec(n1);end;
if(i1=0) and (j1=0) then f:=true;

until f=true;
Writeln('Новая матрица');
for i:=1 to n1 do begin
for j:=1 to m1 do
write(a[i,j]:5);
writeln;
end;
readkey;
End.

Сообщение отредактировано: Seoron - 18.11.2010 0:01