Другие языки программирования и технологии

Помогите с паскалем пожалуйста!

Почему то в результате в исходном файле печатается сумма одной четной строки, содержащей нулевой элемент, даже если таких строк несколько!Что я делаю не так?

program Kurs_1;
const Nmax=20;

{Описание переменных}
Var
a:array [1..Nmax] of integer;
b,c: array [1..Nmax, 1..Nmax] of integer;
f, d, i, j, k, n, m, s: Integer;
f1,f2:text;{текстовые переменные}

{Подпрограмма 1}
{Создание матрицы С, при помощи сортировки столбцов в порядке убывания сумм элементов}
procedure MadeC;
begin
c := b;
for i := 1 to m - 1 do
for j := 1 to m - i do
if a[j] < a[j + 1] then
begin
d := a[j];
a[j] := a[j + 1];
a[j + 1] := d;
for k := 1 to n do
begin
d := c[k, j];
c[k, j] := c[k, j + 1];
c[k, j + 1] := d;
end;
end;
end;

{Подпрогрмма 2}
{Нахождение четных строк содержащих хотя бы один нулевой элемент в матрице С}
procedure Summa;
begin
f := 0;
for i := 1 to n div 2 do
for j := 1 to m do
if c[i * 2, j] = 0 then
begin
f:=1;
s:=0;
for k:=1 to n do
s:=s+c[2*i,k];
end;
end;

begin
assign(f1, ‘input.txt’); {Установка связи между текстовой переменной и входным файлом}
assign(f2, ‘output.doc’);{Установка связи между текстовой переменной и исходным файлом}
reset(f1);
rewrite(f2);

readln(f1,n);
readln(f1,m);

for i := 1 to n do
for j := 1 to m do
begin
readln(f1, b[i, j]);
a[j] := a[j] + b[i, j];
end;

for j := 1 to m do
a[j] := abs(a[j]); {Функция модуль}

MadeC;

writeln(f2, 'Matrica B:'); {Вывод исходной матрицы}
for i := 1 to n do
begin
for j := 1 to m do
write(f2, b[i, j], ' ');
writeln(f2);
end;
writeln(f2, 'Matrica C:');{Вывод матрицы результата}
for i := 1 to n do
begin
for j := 1 to m do
write(f2, c[i, j], ' ');
writeln(f2);
end;

Summa ;
if f=1 then
writeln(f2, 'Summa elementov v stroke s chetnimi nomerami s nulevimi elementami ',2*i, '= ', s)
else writeln(f2,‘Ne syshestvyet chetnich strok s nulevimi elementami’);
close(f1);
close(f2);
end.
в подпрограмме 1 строчка for j := 1 to m - i do ошибочна вероятно, если правлиьно я понимаю напиши ее как for j := 1 to m - 1 do

нет, вроде нормально все. это я кривой))) ) но всеравно обрати внимание на то как у тебя индексы в цыклах стоят
Yerbol Ulukbanov
Yerbol Ulukbanov
6 684
Лучший ответ
В основной программе вместо:

Summa ;
if f=1 then
writeln(f2, 'Summa elementov v stroke s chetnimi nomerami s nulevimi elementami ',2*i, '= ', s)
else writeln(f2,‘Ne syshestvyet chetnich strok s nulevimi elementami’);

Нужно:

i := 2; k := 0;
while i < n do
  begin
    S := Summa( i );
    if S > 0 then
      begin
        WriteLn(i, ' строка. Сумма = ', S);
        Inc(k);
      end;
    Inc( i, 2);
  end;
if k = 0 then
  WriteLn('Не существует чётных строк с нулевыми элементами. ');

Функция вместо процедуры:

function Summa(i : Integer) : Integer;
var
  Res, K0, j : Integer;
begin
  Res := 0;
  K0 := 0;
  for j := 1 to m do
    begin
      Res := Res + c[ i, j ];
      if c[ i, j ] = 0 then
        Inc(K0);
    end;
  if K0 = 0 then
    Summa := 0
  else
    Summa := Res;
end;
Сергей Худолей
Сергей Худолей
70 578
procedure Summa;
begin
f := 0;
for i := 1 to n div 2 do (здесь вот косяк у тебя идет перебор строк только до n деленое на 2, т. е. например у тебя массив состоит из 10 строк, ты просматриваешь только 5 из них, отсюда скорее всего он из этих 5 находит только одну удовлетворяющую поиску)
for j := 1 to m do
if c[i * 2, j] = 0 then
begin
f:=1;
s:=0;
for k:=1 to n do
s:=s+c[2*i,k];
end;
end;
Рома Стечкин
Рома Стечкин
1 967