Добрый вечер. Нужно написать программу которая в квадратной матрице удалит строки и столбцы состоящие только из нулей, при этом поиск нулевы строк и столбцов нужно оформить как процедуры
volvo
18.11.2010 2:21
Что значит "удалит"? Если матрица не динамическая, то из нее в принципе ничего удалить нельзя. Можно сделать какие-то махинации с переносом столбцов на один левее/строк - на одну выше, или можно пропустить при выводе. И тот и другой вариант уже рассматривался прямо на этому форуме. Ищи, делай свою программу, что будет непонятно - спросишь.
Seoron
18.11.2010 2:54
Ой я немного не так написал, в задаче вобще написано уплотните квадратную матрицу влево и вверх, для выявления нулевы строк и столбцов используйте подпрограмму. Я вот написал прогу только вот что-то не работает
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
Гость
18.11.2010 3:24
А почему он удаляет только одну плохую строку/столбец?
Seoron
18.11.2010 4:00
Всё, сделал, можите удалить тему или оставить комуто на будующее. вот рабочяя программа
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.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.