Двумерные массивы, Подскажите из-за чего ошибка? Опции

[Neon6868]

Задание: Дана целочисленная прямоугольная матрица.Определить количество столбцов,не содержащих ни одного нулевого элемента (оформить в виде функции). Характеристикой строки целочисленной матрицы назовем сумму её положительных четных элементов. Переставляя строки заданной матрицы, расположить их в соответствии с ростом характеристик (оформить в виде процедуры).

Программа неправильно переставляет строки. Я понял, что программа неправильно считает характеристики (в программе выделено синим цветом)! Подскажите почему, вроде бы все написано правильно.
Программа:

Program HACK;
const
n=3;
m=4;
type
mas1=array [1..n,1..m] of integer;
var
i,j,kol:integer;
a:mas1;
function Nul(a:mas1):integer;
var
i,j:integer;
chis:integer;
mas2:array [1..m] of boolean;
begin
chis:=0;
for i:=1 to m do
mas2[i]:=true;
for j:=1 to m do
for i:=1 to n do
if a[i,j]=0 then mas2[j]:=false;
for j:=1 to m do
if mas2[j]=true then chis:=chis+1;
Nul:=chis;
end;
procedure perestanovka(var a:mas1);
var
mas2:array[1..n] of integer;
min,min_el,l,save:integer;
begin
for i:=1 to n do
mas2[i]:=0;

for i:=1 to n do
for j:=1 to m do
if (a[i,j]>0) and (odd(a[i,j])=false) then
mas2[i]:=mas2[i]+a[i,j];
for j:=1 to n do begin
min:=j;
min_el:=mas2[j];
for i:=j+1 to n do begin
if mas2[i]<min_el then begin
min:=i;
min_el:=mas2[i];
end;
end;
for l:=1 to m do begin
save:=a[min,l];
a[min,l]:=a[j,l];
a[j,l]:=save;
end;
end;
End;
begin
randomize;
write('Isxodnii massiv:');
for i:=1 to n do begin
writeln;
for j:=1 to m do begin
a[i,j]:=random(15)-8;
write (a[i,j],'  ');
end;
end;
kol:=Nul(a);
writeln;
write('Kol-vo stolbcov, ne soderzhaschix ni odnogo nulevogo elementa=');
writeln(kol);
Perestanovka(a);
writeln('Preobrazovannii massiv:');
for i:=1 to n do begin
writeln;
for j:=1 to m do
write (a[i,j],'  ');
end;
End.

Сообщение отредактировано: Neon6868 - 24.05.2008 22:36

[volvo]

Подскажите из-за чего ошибка?

Из-за того, что сам себе проблемы делаешь... Все проще гораздо, не надо никаких лишних переменных (показываю только перестановку строк, со столбцами, не содержащими нулей по-моему у тебя все нормально):

{
  Немного по-другому опишем типы...
  Это не повлияет на остальную часть программы...
}
type
  vec = array[1 .. m] of integer;
  mas1 = array[1 .. n] of vec;

...

procedure perestanovka(var a: mas1);

  function f(v: vec): integer; { <--- вот тут вычисляется "характеристика" строки }
  var i, s: integer;
  begin
    s := 0;
    for i := 1 to m do
      if (v[i] > 0) and not odd(v[i]) then s := s + v[i];
    f := s;
  end;

var
  T: vec;
begin
  { и собственно сортировка... }
  for i := 1 to n do
    for j := n downto i + 1 do
      if f(a[j-1]) > f(a[j]) then begin
        T := a[j-1]; a[j-1] := a[j]; a[j] := T;
      end
end;