Задача с матрицами, Прошу помощи в решении. Опции

[jetman]

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

Сообщение отредактировано: jetman - 18.10.2005 10:01

[jetman]

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.

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

[volvo]

{ Должен ведь ограничивать максимальный размер матрицы, но почему то этого не делает}

:yes: Должен... При условии, что ты будешь матрицу вводить, как положено! Смотри внимательно:

procedure InitArray(var x : TArr);
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;

Вывод: никогда не давай локальным переменным тех же имен, что и глобальным... Вот правильный вариант InitArray:

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;