Форум программистов
 
О проблемах, например, с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Delphi > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 26.12.2008, 18:28   #1
Rav4
Новичок
Джуниор
 
Регистрация: 26.12.2008
Сообщений: 1
По умолчанию Задача по стандартной матрице. Нужна помощь!

Здравствуйте. У меня тут задачка есть одна, вот ее условие:
"В заданной матрице найдите две строки с равными количествами нулевых элементов. Вычтите элементы строки с меньшим номером из соответствующих элементов всех строк".

В общем то я ее решил и она даже работает. Вот ее код (пишу здесь впервые, поэтому буду надеяться, что код на форуме ввёл всё-таки правильно):
Код:
program z8;
uses crt;
var
M:array[1..3,1..4] of integer;
B:array[1..3] of integer;
s:integer;
i,j:byte;
begin
for i:=1 to 3 do
for j:=1 to 4 do
 read(M[i,j]);
for i:=1 to 3 do
for j:=1 to 4 do
if M[i,j]=0 then B[i]:=B[i]+1;
writeln('Количество нулевых элементов в 1 строке: ',B[1]);
writeln('Количество нулевых элементов во 2 строке: ',B[2]);
writeln('Количество нулевых элементов в 3 строке: ',B[3]);


writeln('Пара(ы) строк с одинаковыми количествами нулевых элементов: ');
if B[1]=B[2] then
begin
for j:=1 to 4 do
write(M[1,j], ' ');
writeln;
for j:=1 to 4 do
write(M[2,j], ' ');
end;
writeln;
writeln;
if B[2]=B[3] then
begin
for j:=1 to 4 do
write(M[2,j], ' ');
writeln;
for j:=1 to 4 do
write(M[3,j], ' ');
end;
writeln;
writeln;
if B[1]=B[3] then
begin
for j:=1 to 4 do
write(M[1,j], ' ');
writeln;
for j:=1 to 4 do
write(M[3,j], ' ');
end;
if (B[1]<>B[2]) and (B[2]<>B[3]) and (B[1]<>B[3]) then
writeln ('Строк с одинаковыми количествами нулевых элементов нет!');
readln;
Writeln('Разность соответствующих элементов 2 и 1 строки равна: ');
for j:=1 to 4 do
begin
s:=M[2,j]-M[1,j];
write(s, ' ');
end;
writeln;
Writeln('Разность соответствующих элементов 3 и 1 строки равна: ');
for j:=1 to 4 do
begin
s:=M[3,j]-M[1,j];
write(s, ' ');
end;
end.
Она работает, но преподавателю нужно более рациональное решение, а точнее до пустых пробелов-абзацев (специально отделил тут две части текста программы) всё нормально, а дальше (это видно и в коде, но проще увидеть это на блок-схеме) слишком много "повторов" (например в тех кусках программы, где я использую условные операторы, сравнивая сначала В[1] и В[2], потом В[2] и В[3], ну и В[1] и В[3]. И еще момент, где я вычитаю элементы 1 строки из соответствующих элементов 2 и 3 строк). Собственно вопрос: можно всё это дело упростить, чтобы не использовать трижды подряд громоздкие (из-за циклов) условные операторы? Помогите пожалуйста, а то никак не вдуплю. В принципе задачу решал сам, без посторонней помощи и в задаче своей ориентируюсь, но как упростить ума не приложу.

p.s. Я взял матрицу 3х4 и составлял задачу для нее.

Последний раз редактировалось Rav4; 26.12.2008 в 19:04.
Rav4 вне форума Ответить с цитированием
Старый 26.12.2008, 21:38   #2
Tkirill
Форумчанин
 
Аватар для Tkirill
 
Регистрация: 22.12.2008
Сообщений: 104
По умолчанию Попробуй вот так :

begin
clrscr;
write(' Вводите матрицу построчно ');
writeln;
writeln;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
readln(mas[i,j]);
end;
end;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
write(mas[i,j],' ');
end;
writeln;
end;
for i1:=1 to 5 do
begin
for i2:=1 to 5 do
begin
if (i1<>i2) then
begin
kol1:=0;
kol2:=0;
for j:=1 to 5 do
begin
if mas[i1,j]=0 then inc(kol1);
if mas[i2,j]=0 then inc(kol2);
end;
if (kol1=kol2) and (kol1<>0) then st:=max(i1,i2);
end;
end;
end;
writeln;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
if i<>st then
mas[i,j]:=mas[i,j]-mas[st,j];
end;
end;
writeln;
writeln(' Результат');
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
write(mas[i,j],' ');
end;
writeln;
end;
readln;
end.
Tkirill вне форума Ответить с цитированием
Старый 26.12.2008, 21:48   #3
Tkirill
Форумчанин
 
Аватар для Tkirill
 
Регистрация: 22.12.2008
Сообщений: 104
По умолчанию начало не пропечаталось)

uses crt;
var
mas:array[1..5,1..5] of integer;
i1,i2,i,j,st,kol1,kol2:integer;
function max(x,y:integer):integer;
begin
if x<y then max:=x
else max:=y;
end;
begin
clrscr;
write(' ');
writeln;
writeln;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
readln(mas[i,j]);
end;
end;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
write(mas[i,j],' ');
end;
writeln;
end;
for i1:=1 to 5 do
begin
for i2:=1 to 5 do
begin
if (i1<>i2) then
begin
kol1:=0;
kol2:=0;
for j:=1 to 5 do
begin
if mas[i1,j]=0 then inc(kol1);
if mas[i2,j]=0 then inc(kol2);
end;
if (kol1=kol2) and (kol1<>0) then st:=max(i1,i2);
end;
end;
end;
writeln;
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
if i<>st then
mas[i,j]:=mas[i,j]-mas[st,j];
end;
end;
writeln;
writeln(' Rezultat ');
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
write(mas[i,j],' ');
end;
writeln;
end;
readln;
end.
Tkirill вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна помощь (задача с массивом)... Goldberg Паскаль, Turbo Pascal, PascalABC.NET 36 19.04.2011 19:31
Задача Whlie do нужна помощь shadowburn Паскаль, Turbo Pascal, PascalABC.NET 3 21.11.2008 19:06
[C] Задача на указатели . Нужна помощь shtkuh Помощь студентам 1 26.01.2008 08:47
Задача с матрицей(нужна помощь) VDK23RUS Помощь студентам 5 14.06.2007 11:55


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS