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

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

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

> Задача с матрицами, Прошу помощи в решении.
сообщение
Сообщение #1


Новичок
*

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

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


Проблема не дающая заснуть уже четвертый день:
Дана целая матрица размера nxm. Для каждой строки матрицы найти сумму четных элементов и произведение нечетных. Результаты оформить в виде матрицы (nx2). В полученной матрице упорядочить (переставить) строки по возрастанию второго элемента в строке.
Буду признателен за любую помощь.

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


Новичок
*

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

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



program test;

uses crt;

const

n=5; {Должен ведь ограничивать максимальный размер матрицы,

m=5; но почему то этого не делает}

type

TVec = array[1 .. m] of integer;

TArr = array[1 .. n] of TVec;

procedure InitArray(var x : TArr);

var i, j, m, n : byte;

begin

clrscr;

repeat

begin;

write('Enter lines quantity, please: ');

readln(n);

end;

until (n>0) and (n<=n);

repeat

begin

write('Enter columns quantity, please: ');

readln(m)

end

until (m>0) and (m<=m);

for i := 1 to n do

for j := 1 to m do

begin;

write('x[', i, ',', j, '] = '); readln(x[i,j]);

end;

end;

procedure PrintArray(x : TArr ; sizeN, sizeM : byte);

var i, j : byte;

begin

for i := 1 to sizeN do begin

writeln;

for j := 1 to sizeM do

write(x[i,j]: 2, ' ');

end;

writeln;

end;

function Addition(x : TArr; i : byte) : integer;

var

j : byte;

S : integer;

begin

s := 0;

for j := 1 to m do

if not odd(x[i, j]) then

inc(s, x[i, j]);

Addition := s;

end;

function Multiplication(x : TArr; i : byte) : integer;

var

j : byte;

p : integer;

begin

p := 1;

for j := 1 to m do

if odd(x[i, j]) then

p := p * x[i, j];

Multiplication := p;

end;

procedure SortResult(var x : TArr);

var

i: byte;

flag: boolean;

T: TVec;

begin

flag := false;

repeat

flag := true;

for i := 1 to n-1 do

if x[i, 2] < x[succ(i), 2] then begin

flag := false;

T := x[i]; x[i] := x[succ(i)]; x[succ(i)] := T

end;

until flag;

end;

var

arr, _result : TArr;

t: byte;

Begin

clrscr;

InitArray(arr);

PrintArray(arr, n, m);

for t := 1 to n do begin

_result[t, 1] := Addition(arr, t);

_result[t, 2] := Multiplication(arr, t);

end;

writeln('Interval result');

PrintArray(_result, n, 2);

writeln('Final result');

SortResult(_result);

PrintArray(_result, n, 2);

writeln('Press enter for exit');

readln;

End.



Получилось вот так, но есть одна проблема лишние нули (и как я понимаю неверный результат).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 





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