Помощь - Поиск - Пользователи - Календарь
Полная версия: Не получается в матрице удалять отдельные элементы.помогите
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Евгения141294
Требуется разработать алгоритм и программу расчета матрицы содержащей в себе все четные числа другой матрицы. Размер матрицы задан 6*6

У меня получилось только оставить четные числа,а как составить матрицу содержащую только четные другой не могу понять как сделать((




Program lr4;
uses crt;
const n=6;

type matrA = array[1..n, 1..n] of integer;
matrB = array[1..n, 1..n] of string;
matrC = array[1..n, 1..n] of string;
Var
i,j,S:integer;
V:string;
a:matrA;
b:matrB;
c:matrC;

procedure vvod;
var i,j:integer;
begin
textattr:=green;
gotoxy (20,4);
writeln ('Ввведите элемент массива :');
for i:=1 to n do
begin
for j:=1 to n do
begin

textattr:=yellow;
write ('A[',i,',',j,']=');
read (A[i,j]);

S:=A[i,j];
Str (S,V);
C[j,i]:=V;
B[j,i]:=C[j,i];
end;
end;
end;
function chot:integer;
begin
chot:=A[i,j];
end;

begin

clrscr;
vvod;

for i:=1 to n do
begin
for j:=1 to n do
begin
if A[i,j] mod 2 <> 0 then
B[i,j]:=' '
else
begin
A[i,j]:=chot;
S:=A[i,j];
Str(S,V);
B[i,j]:=V;
end;

end;
end;


clrscr;
gotoxy (1,9);
for i:=1 to n do
begin
for j:=1 to n do
begin
write (A[i,j]);
write (' ');
end;
writeln ('');
end;
readln;

gotoxy(1,20);
for i:=1 to n do
begin
for j:=1 to n do
begin
write (B[i,j]:3);
write (' ');
end;
writeln ('');
end;
readln;
end.
Федосеев Павел
А можно привести полностью условие задачи так, как оно записано в методичке.
Я просто не могу понять, что делать с нечётными числами. Да и с чётными тоже непонятно.

Предположим, что чётные остаются на своих местах, а нечётные заменяются на число 1.

Тогда прога может выглядеть так:

var
A, B : matrA; <------ пусть обе матрицы будут целочисленными
..................................
begin
{ввод исходных даных}
vvod; <------- исправленная подпрограмма с учётом другого типа матрицы B
{обработка}
for i:=1 to n do
for j:=1 to n do
if Odd(A[i, j]) then <------ Odd(x) эквивалент x mod 2 <> 0
B[i, j]:=1
else
B[i, j]:=A[i, j];
{вывод результатов}
for i:=1 to n do
begin
for j:=1 to n do
Write(B[i, j]:4);
WriteLn; <------ можно так вместо WriteLn('')
end;
end.


Или же нужно построить новую матрицу, состоящую из имеющихся чётных чисел. Например, в исходной матрице 6x6 содержится 21 чётное число. Из этих 21 чисел можно организовать матрицу 3x7.

В общем, что нужно-то получить в итоге?
Евгения141294
нужно новую матрицу сформировать ,что бы она содержала только четные числа первой матрицы

примерно вот так думаю:
Нажмите для просмотра прикрепленного файла


только я не совсем понимаю как это сделать(
Федосеев Павел
Ну, такую "матрицу" можно "заполнить" очень просто
  for i:=1 to n do
begin
for j:=1 to n do
if NOT Odd(A[i, j]) then
Write(A[i, j]:4);
WriteLn;
end;


Но мы же понимаем, что это не матрица.

Т.к. исходного условия я от тебя не дождался, то могу фантазировать. Давай сформируем результирующую матрицу по следующему принципу:
- просматриваем всю матрицу A и в список EvenList сохраняем только чётные числа из неё
- после завершения просмотра у нас есть список EvenList и количество чётных чисел EvenNum
- если EvenNum=0, то завершаем программу с сответствующим собщением
- У нас есть число EvenNum, и мы можем его перебором всех комбинаций разложить на два множителя Nb и Mb. Эти множители и будут размерностью новой матрицы B. Можно даже постараться отдать приоритет квадратным матрицам, задав критерий не только Nb*Mb=EvenNum, но и (Nb+Mb)->min - очевидно, что сумма сторон квадратной матрицы меньше чем у прямоугольной.
- теперь у нас есть и список чётных и размерность новой матрицы - заполняем её.

Вуаля. Выводим результат - матрицу B.

Для приведённого на твоём скриншоте примера результат будет:
Код
   2   4   6   8
   8   6   4   2
   2   4   6   8
   4   0   2   4


Пробуешь?
Подкину фрагмент для поиска Nb и Mb
  Nb:=1;
Mb:=EvenNum;
for i:=2 to round(sqrt(EvenNum)+1) do
if EvenNum mod i = 0 then
begin
j:=EvenNum div i;
if (i+j)< (Nb+Mb) then
begin
Nb:=i;
Mb:=j;
end;
end;

И ещё, чтобы при отладке не водить матрицу, можно задать её константой
const
n = 6;

type
matrA = array[1..n, 1..n] of integer;

const
A : matrA =
(
(1, 2, 3, 4, 5, 6),
(7, 8, 9, 9, 8, 7),
(6, 5, 4, 3, 2, 1),
(1, 2, 3, 4, 5, 6),
(9, 8, 7, 4, 5, 0),
(1, 2, 3, 5, 4, 7)
);
Евгения141294
я просто не нашла условие задачи,как в методичке))
так я поняла ))
спасибо большое,я попробую

а если мы сохранили четные числа в список, как заполнить им матрицу В?
Федосеев Павел
Например, по-порядку следования в списке. С 1 по Nb - первая строка матрицы, с (Nb+1) по 2*Nb - вторая строка матрицы...
  for i:=1 to Nb do
for j:=1 to Mb do
B[i, j]:=EvenList[(i-1)*Nb+j];


--------------------------------
Прошу прощения. Строка матрицы, конечно же от 1 до Mb. И
  for i:=1 to Nb do
for j:=1 to Mb do
B[i, j]:=EvenList[(i-1)*Mb+j];
Евгения141294
Так вроде бы работает,кроме одного
Я когда сохраняю в список,он у меня как то частично сохраняет,ошибка где-то?


begin
EvenNum:=0;
for i:=1 to n do
begin
for j:=1 to n do
begin
if not Odd(A[i,j]) then
(EvenList[i]):=A[i,j];
if not Odd(A[i,j]) then
EvenNum:=EvenNum+1;
end;
end;
for i:=1 to EvenNum do
begin
write (EvenList[i]);
end;
writeln;
writeln (EvenNum);
-Федосеев Павел-

...............
if not Odd(A[i, j]) then
begin
EvenList[EvenNum]:=A[i, j];
EvenNum:=EvenNum+1;
end;


-Федосеев Павел-
Вернее, наоборот

for i:=1 to n do
for j:=1 to n do
if not Odd(A[i, j]) then
begin
EvenNum:=EvenNum+1;
EvenList[EvenNum]:=A[i, j];
end;
if EvenNum=0 then
begin
WriteLn('Чётных чисел в матрице нет.');
Halt;
end;
Евгения141294
А если у меня четных чисел например 17 ?
он мне строкой выдаёт эти 17 чисел
вот что у меня получилось

Program lr4;
uses crt;
const n=6;

type matrA = array[1..n, 1..n] of integer;
matrB = array[1..n, 1..n] of integer;


Var
i,j,EvenNum,Nb,Mb:integer;

EvenList:array[1..36] of integer;
a:matrA;
b:matrB;


procedure vvod;
var i,j:integer;
begin
textattr:=green;
gotoxy (20,4);
writeln ('‚ўҐ¤ЁвҐ н«Ґ¬Ґ­в ¬ ббЁў :');
for i:=1 to n do
begin
for j:=1 to n do
begin

textattr:=yellow;
write ('A[',i,',',j,']=');
read (A[i,j]);
end;
end;
end;


begin

clrscr;
vvod;
EvenNum:=0;
for i:=1 to n do
begin
for j:=1 to n do
begin
if not Odd(A[i,j]) then
begin
EvenNum:=EvenNum+1;
EvenList[EvenNum]:=A[i,j];
end;
end;
end;

if EvenNum=0 then
begin
WriteLn('Чётных чисел в матрице нет.');
Halt;
end;

writeln;
writeln (EvenNum);

Nb:=1;
Mb:=EvenNum;
for i:=2 to round(sqrt(EvenNum)+1) do
if EvenNum mod i = 0 then
begin
j:=EvenNum div i;
if (i+j)< (Nb+Mb) then
begin
Nb:=i;
Mb:=j;
end;
end;

For i:=1 to Nb do
for j:=1 to Mb do
B[i,j]:=EvenList[(i-1)*Mb+j];

for i:=1 to Nb do
begin
for j:=1 to Mb do
begin
write (B[i,j]:3);
write (' ');
end;
writeln ('');
end;


readln;
readln;
end.


Федосеев Павел
Значит получится матрица 1x17 - из одной строки.
Боюсь, что уточнение формулировки условия ты получишь при защите лабы. Но у тебя есть задатки - подправишь прогу на месте.

Ещё, как говорят комивояжёры, "товар вдогонку"...
Могу порекомендовать использовать форматтеры исходных текстов для паскаля перед сдачей преподавателю. Рекомендую JCF (Jedy Code Format) - именно им я обработал твой исходник для лучшего понимания.

PS У тебя в компиляторе выключены опции проверки на корректность диапазона - поэтому прога не завершилась аварийно. Добавь в начале программы строку {$R+} и увидишь "вылет" на результате 1х17

const
nn = n*n;
type
massA = array [1..nn] of integer; <------ удобнее описать все типы, а потом их использовать.

type
matrB = array [1..n, 1..nn] of integer; <------ именно nn - мы ведь можем получить 2x17 или 1x31

var
i, j : integer;
EvenNum : integer; {количество чётных чисел в исходной матрице}
EvenList: massA;
Nb, Mb : integer; {размерность новой матрицы}
A : matrA;
B : matrB;

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.