Проблема не дающая заснуть уже четвертый день:
Дана целая матрица размера nxm. Для каждой строки матрицы найти сумму четных элементов и произведение нечетных. Результаты оформить в виде матрицы (nx2). В полученной матрице упорядочить (переставить) строки по возрастанию второго элемента в строке.
Буду признателен за любую помощь.
А что уже готово, какие моменты неопнятны/не получаются ? Вот загляни в наш FAQ по массивам и матрицам, может найдешь ответы на свои вопросы : http://forum.pascal.net.ru/index.php?showtopic=2694
На усмотрение модератора выкладываю свое решение, захотелось отвлечься и решил сделать задачу :p2:
код временно скрыт... Пусть автор сначала скажет что у него конктретно не получается. админ.
вырезанно
АВТОР ПРОГРАММЫ: klem4
uses crt;
const
n=3;
m=4;
type
TArr = array[1..n, 1..m] of integer;
var
arr : TArr;
result : TArr;
t : byte;
procedure InitArray(var x : TArr);
const
rnd = 11;
var
i,j : byte;
begin
randomize;
for i := 1 to n do
for j := 1 to m do
x[i,j] := random(rnd);
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;
j := 2;
while(j<=m) do begin
inc(s, x[i,j]);
inc(j, 2);
end;
Addition := s;
end;
function Multiplication(x : TArr; i : byte) : integer;
var
j : byte;
p : integer;
begin
p := 1;
j := 1;
while(j<=m) do begin
p := p*x[i,j];
inc(j, 2);
end;
Multiplication := p;
end;
procedure SortResult(var x : TArr);
var
i,temp : byte;
flag : boolean;
begin
flag := false;
repeat
flag := true;
for i := 1 to n-1 do
if not(x[i, 2]>=x[succ(i), 2]) then begin
flag := false;
temp := x[i, 1];
x[i, 1] := x[succ(i), 1];
x[succ(i), 1] := temp;
temp := x[i, 2];
x[i, 2] := x[succ(i), 2];
x[succ(i), 2] := temp;
end;
until flag;
end;
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;
PrintArray(result, n, 2);
SortResult(result);
PrintArray(result, n, 2);
readln;
End.
program test;
uses crt;
Const
NN=10;
MM=10;
type
TElem = integer;
Matrix = array[1..NN,1..MM] of integer;
Procedure ReadMatr(var A:Matrix; var n,m:word );
var
i,j:word;
begin
clscr;
repeat
write('Enter stroks: '); readln(N)
until (N>0) and (N<=NN);
repeat
write('Enter stolbs: '); readln(M)
until (M>0) and (M<=MM);
For i:=1 to n do
begin
For j:=1 to m do
begin
write('A[',i,j,']= ');
readln(A[i,j])
end
end
end;
begin
For i:=1 to n do
begin
For j:=1 to m do
begin
if i mod 2 = 0 then
...........................
Procedure PrintMatr(A:Matrix; n,m:word);
Var
i,j:word;
begin
For i:=1 to n do
begin
For j:=1 to m do write(A[i,j],' ');
writeln
end
end;
var
n,m:word;
a:matrix;
Begin
Readmatr(a,n,m);
PrintMatr(a,n,m);3
readln;
end.
Еще один вариант, более простой и, по-моему, более правильно интерпретирующий условие (пока тоже скрыто) :
uses crt;
const
n=3;
m=4;
type
TVec = array[1 .. m] of integer;
TArr = array[1 .. n] of TVec;
procedure InitArray(var x : TArr);
var i, j : byte;
begin
randomize;
for i := 1 to n do
for j := 1 to m do
x[i, j] := random(11);
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;
PrintArray(_result, n, 2);
SortResult(_result);
PrintArray(_result, n, 2);
readln;
End.
const m = ...; n = ...;Для умножения - аналогично...
{ a - сама матрица, i - номер строки, в которой искать сумму }
function sum(a: matrix; i: byte): integer;
var j, s: integer;
begin
s := 0;
for j := 1 to m do
if not odd(a[i, j]) then inc(s, a[i, j]);
sum := s;
end;
:fire: :help:
Я в тупике (точнее тупик в моей голове) :ypr: . Ну не могу я написать эту :ryg: программу. Мож чего не догнал :orangun: И так еще раз и попорядку:
1. Мне надо ВВЕСТИ матрицу в память (точно вот так):
program test;
uses crt;
const
NN=10;
MM=10;
type
TElem = integer;
Matrix = array[1..NN,1..MM] of integer;
Procedure ReadMatr(var A:Matrix; var n,m:word );
var
i,j:word;
begin
clrscr;
repeat
write('Enter stroks: '); readln(N)
until (N>0) and (N<=NN);
repeat
write('Enter stolbs: '); readln(M)
until (M>0) and (M<=MM);
For i:=1 to n do
begin
For j:=1 to m do
begin
write('A[',i,j,']= ');
readln(A[i,j])
end
end
end;
function sum(a: matrix; i: byte): integer;
var j, s, n: integer;
begin
s := 0;
for j:= 1 to n do
if odd(a[i, j]) then inc(s, a[i, j]);
sum := s;
end;
function umn(a: matrix; i: byte): integer;
var j, r, n: integer;
begin
r := 0;
for j:= 1 to n do
if not odd(a[i, j]) then (r, a[i, j])*(r, a[i,j]);
umn := r;
end;
???
jetman, во-первых, посмотри пост №6 (я его только что открыл, раньше ты его не мог видеть, ну и пост №4 заодно...), а во вторых:
function umn(a: matrix; i: byte): integer;
var j, r, n: integer;
begin
r := 0; { <-- Здесь первая ошибка !!! }
for j:= 1 to n do
if not odd(a[i, j]) then (r, a[i, j])*(r, a[i,j]); { <-- Вторая ошибка !!! }
umn := r;
end;
...
if not odd(a[i, j]) then r := r * a[i, j];
...
Я конечно дико извиняюсь , но ведь приведенные вами программы работают по принципу случайных чисел, а мне (как я понял) нужно вводит матрицу самому (вручную) или я опять чего-то непонял
Ну, так замени
x[i,j] := random(11);на
beginв процедуре InitArray...
write('x[', i, ',', j, '] = '); readln(x[i,j]);
end;
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.
procedure InitArray(var x : TArr);Вывод: никогда не давай локальным переменным тех же имен, что и глобальным... Вот правильный вариант InitArray:
var i, j, m, n : byte;
begin
clrscr;
repeat
(*
begin;
{ Это лишнее: Repeat ... Until сами являются операторными скобками }
*)
write('Enter lines quantity, please: '); readln(n);
(*
end;
{ Это тоже, соответственно }
*)
until (n>0) and (n<=n);
{
А вот теперь объясни мне, с каким именно N здесь: (n <= N)
происходит сравнение??? Это условие выполнится ВСЕГДА!
n = n в любом случае (ты работаешь с одним и тем же числом,
т.к. локальная переменная перекрывает глобальную)...
}
... { дальше - то же самое... }
end;
program test;
uses crt;
const
_n=5; _m=5;
type
TVec = array[1 .. _m] of integer;
TArr = array[1 .. _n] of TVec;
var
m, n: integer;
procedure InitArray(var x : TArr);
var
i, j: byte;
begin
clrscr;
repeat
write('Enter lines quantity, please: '); readln(n);
until (n>0) and (n<=_n);
repeat
write('Enter columns quantity, please: '); readln(m)
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;
Все работает, поверить не могу, ОГРОМНОЕ Вам человеческое спасибо volvo, klem4, altair