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

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

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


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

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

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

В общем то я ее решил и она даже работает. Вот ее код (пишу здесь впервые, поэтому буду надеяться, что код на форуме ввёл всё-таки правильно):
Код:
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 в 20:04.
Rav4 вне форума   Ответить с цитированием
Старый 26.12.2008, 22:38   #2
Tkirill
Форумчанин
 
Аватар для Tkirill
 
Регистрация: 22.12.2008
Адрес: Москва
Сообщений: 104
Репутация: 69

icq: 460547998
По умолчанию Попробуй вот так :

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, 22:48   #3
Tkirill
Форумчанин
 
Аватар для Tkirill
 
Регистрация: 22.12.2008
Адрес: Москва
Сообщений: 104
Репутация: 69

icq: 460547998
По умолчанию начало не пропечаталось)

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 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

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


15:28.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.