1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Добрый день! Очень прошу помочь со следующей задачей: в заданной квадратной матрице NxN удалить все строки и столбцы, которые содержат нулевой элемент (то есть если находится 0, то надо удалить сразу и строку и столбец). Для одного нуля моя программа работает, но как сделать для большего количества, я не могу понять. Очень прошу помощи, заранее спасибо!
Вот то что я написал:
program Project1; {$APPTYPE CONSOLE} uses SysUtils; const n=4; type telem=integer; mas=array[1..n] of telem; matr=array[1..n] of mas; var i,j,k,p,m:integer; a:matr; procedure delstroka(var a:matr; k:integer); var i,j:integer; begin for i:=k to n-1 do for j:=1 to n do a[i,j]:=a[i+1,j] end; procedure delstolbec(var a:matr; p:integer); var i,j:integer; begin for i:=1 to n do for j:=p to n-1 do a[i,j]:=a[i,j+1] end; procedure vvod(var a:matr); var i,j:integer; begin writeln('vvedite massiv'); for i:=1 to n do for j:=1 to n do read(a[i,j]); end; procedure delnyli(var a:matr); var i,j,p,k,m:integer; begin for i:=1 to n do for j:=1 to n do if a[i,j]=0 then begin k:=i; p:=j; delstroka(a,k); delstolbec(a,p); end; end; procedure print(var a:matr); var i,j:integer; begin for i:=1 to n do begin writeln; for j:=1 to n do write(a[i,j],' '); end; end; begin vvod(a); delnyli(a); print(a); readln; readln; end.
Для одного нуля моя программа работает, но как сделать для большего количества, я не могу понять.
Твоя ошибка заключается в непонимании, что значит удалить строку или столбец. То есть ты понимаешь наполовину: передвигаешь элементы правильно, а вот уменьшить размер матрицы - забываешь. Ведь если мы действительно удаляем их - матрица становится меньше. Поэтому основной цикл нужно изменить. В момент удаления нужно уменьшать размер матрицы (поэтому я ввел дополнительную константу m, а n сделал переменной). И тогда использование цикла FOR тут исключается (в FOR нельзя менять пределы в процессе цикла), и я использовал WHILE. Кроме того, после каждого удаления нужно снова проходить по той же строке сначала (сбрасывать j в 1), так как нули могли прийти в уже просмотренный участок текущей строки в процессе сдвига строки (со столбцом такого произойти не может, так что сбрасывать i в единицу не нужно).
Еще несколько замечаний: 1. при удалении строки достаточно одного цикла (посмотри, как я сделал); 2. не нужно декларировать всякие i,j и т.п. в основной программе, если они нужны тебе только в процедурац и ты там их все равно декларируешь; 3. обрати внимание, как я изменил процедуру Vvod - теперь в конце тебе должно быть достаточно одного ReadLn; 4. форматирование, форматирование и еще раз форматирование!! посмотри, как я сделал и постарайся придерживаться..
Вроде все пока.. Спрашивай, что неясно.
program Project1; {$APPTYPE CONSOLE} uses SysUtils; const m=5; type telem= integer; mas= array[1..m] of telem; matr= array[1..m] of mas; var n: integer;
procedure print(var a:matr); var i,j:integer; begin WriteLn; for i:=1 to n do begin for j:=1 to n do write(a[i,j]:5,' '); writeln; end; end;
procedure DelStroka(var a:matr; k:integer); var i: integer; begin // достаточно одного цикла, если перемещать целые строки for i:=k 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 n do for j:=p to n-1 do a[i,j]:=a[i,j+1] end;
procedure vvod(var a:matr); var i,j:integer; begin writeln('vvedite massiv'); for i:=1 to n do begin for j:=1 to n do read(a[i,j]); ReadLn end end;
procedure DelNyli(var a:matr); var i,j: integer; begin i:=1; while i<=n do begin // for - нельзя j:=1; while j<=n do begin // for - нельзя if a[i,j]=0 then begin DelStroka(a,i); DelStolbec(a,j); Dec(n); // уменьшаем размер матрицы Print(a); // промежуточная печать - убери ее j:=1 // проходим по строке снова с самого начала end else Inc(j) end; Inc(i); end end;
begin n:=m; Print(a); //vvod(a); delnyli(a); print(a); readln; end.
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой