IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> удалить строки с столбцы в матрице
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


Добрый день! Очень прошу помочь со следующей задачей: в заданной квадратной матрице NxN удалить все строки и столбцы, которые содержат нулевой элемент (то есть если находится 0, то надо удалить сразу и строку и столбец). Для одного нуля моя программа работает, но как сделать для большего количества, я не могу понять. Очень прошу помощи, заранее спасибо! smile.gif

Вот то что я написал:
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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(deniska @ 19.03.2010 20:10) *
Для одного нуля моя программа работает, но как сделать для большего количества, я не могу понять.
Твоя ошибка заключается в непонимании, что значит удалить строку или столбец. То есть ты понимаешь наполовину: передвигаешь элементы правильно, а вот уменьшить размер матрицы - забываешь. Ведь если мы действительно удаляем их - матрица становится меньше. Поэтому основной цикл нужно изменить. В момент удаления нужно уменьшать размер матрицы (поэтому я ввел дополнительную константу 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;

const
a: matr=(
(11, 12, 13, 0, 15),
(21, 22, 23, 24, 0),
(31, 32, 33, 34, 35),
(41, 42, 0, 44, 45),
( 0, 52, 53, 54, 55)
);

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.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 12.09.2025 20:19
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name