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

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

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

> Матрица, Обнулить строки и столбцы,где присутствуют нули
Rom1k
сообщение 20.05.2007 18:20
Сообщение #1


Пионер
**

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

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


Задание:
обнулить строку и столбец матрицы в которой имеется "0"

можно использовать вспомогательный одномерный массив.
ввожу матрицу,а дальше что делать?
помогите,плизззззз!

uses crt;

const
Nmax=10;{Максимальное значение строк и столбцов матрицы}
type
mas=array[1..Nmax,1..Nmax] of integer;
var
A:mas;
N,M:byte;{Кол-во строк и столбцов}

procedure vvod_mas(var a:mas;var n,m:byte);
{Ввод матрицы с запоминанием позиции,для последующего
обнуления строки и столбца}
var i,j:integer;
begin
repeat
Write('Zadaite 4islo strok v matrice (1..',nmax,'): ');
ReadLn(N);
If (N<=0) and (N>Nmax) then
WriteLn('error! povtorite!');
until (N>0) and (N<=Nmax);
repeat
Write('Zadaite 4islo stolbcov (1..',nmax,'): ');
ReadLn(M);
If (M<=0) and (M>Nmax) then
WriteLn('Error! Povtorite!');
until (M>0) and (M<=Nmax);

WriteLn('Zadaite elementi matrici po strokam 4erez probel ');
For i:=1 to N do
begin
Write('Stroka ',i,': ');
for j:=1 to M do
begin
Read(A[i,j]);
end;
end;
end;

procedure vivod(var a:mas;var n,m:byte);
var i,j:integer;
begin
WriteLn('Rezultat: ');
for i:=1 to N do
begin
for J:=1 to M do
Write(a[i,j]:4);
WriteLn;
end; end;

BEGIN{main}
clrscr;
vvod_mas(a,n,m);
vivod(a,n,m);
writeln;
readkey;
end.



 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 20.05.2007 22:55
Сообщение #2


Гость






{ сама процедура ... }
procedure process(var a: mas; n, m: byte);
var
i, j, k: integer;
buffer: array[1 .. 2*sqr(nmax)] of integer;
count: integer;
begin
count := 0;
for i := 1 to n do
for j := 1 to m do
if a[i, j] = 0 then begin
inc(count); buffer[count] := i;
inc(count); buffer[count] := j;
end;

i := 1;
while i < count do begin

for k := 1 to n do
a[buffer[i], k] := 0;
for k := 1 to m do
a[k, buffer[i + 1]] := 0;
inc(i, 2);

end;
end;

...
vvod_mas(a,n,m);
process(a, n, m); { и ее вызов ... }
vivod(a,n,m);
...
 К началу страницы 
+ Ответить 
Rom1k
сообщение 22.05.2007 22:43
Сообщение #3


Пионер
**

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

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


[quote name='volvo' date='20.05.2007 23:55' post='103288']

она не корректно работает в некоторых случаях.
Вот мой вариант программы,он проще,но он тоже не корректно работает в некоторых ситуациях
Program z_2;
uses crt;
const
Nmax=10;{Максимальное значение строк и столбцов матрицы}
type
mas=array[1..Nmax,1..Nmax] of integer;
var
A:mas;
N,M:byte;{Кол-во строк и столбцов}
{---------------------------------------------------------------------------}
procedure vvod_mas(var a:mas; n,m:byte);
{Ввод матрицы}
var i,j:integer;
begin
repeat
Write('Задайте число строк в матрице (1..',nmax,'): ');
ReadLn(N);
If (N<=0) or (N>Nmax) then
WriteLn('Ошибка! Повторите!');
until (N>0) and (N<=Nmax);
repeat
Write('Задайте число столбцов в матрице (1..',nmax,'): ');
ReadLn(M);
If (M<=0) or (M>Nmax) then
WriteLn('Ошибка! Повторите!');
until (M>0) and (M<=Nmax);

WriteLn('Задайте элементы матрицы строкам через пробел ');
For i:=1 to N do
begin
Write('Строка ',i,': ');
for j:=1 to M do
begin
Read(A[i,j]);
end;
end;
end;
{---------------------------------------------------------------------------}
procedure obnul(var a:mas;n,m:integer);
var
i,j,k:integer;
b:array[1..nmax*4] of integer;
t:integer;
begin
t:=0;
for i:=1 to n do
for j:=1 to m do
if a[i,j]=0 then begin
t:=t+1;
b[t]:=i;
t:=t+1;
b[t]:=j;
end;{if}

i:=i+1;
while i<t do begin

for k:=1 to n do
a[b[i],k]:=0;
for k:=1 to m do
a[k,b[i+1]]:=0;
i:=i+1;
end;{while}
end;{obnul}
{---------------------------------------------------------------------------}
procedure vivod(var a:mas;var n,m:byte);
var i,j:integer;
begin
WriteLn('Результат: ');
for i:=1 to N do
begin
for J:=1 to M do
Write(a[i,j]:4);
WriteLn;
end; end;
{---------------------------------------------------------------------------}
BEGIN{main}
clrscr;
vvod_mas(a,n,m);
vivod(a,n,m);
readkey;
end.{main}



может что-то можно исправит?!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 



- Текстовая версия 20.07.2025 18:34
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"