Представить в виде процедур и функций

[Flocky]

Есть задача:
1) Упорядочить строки целочисленной прямоугольной матрицы по возрастанию количества одинаковых элементов в каждой строке (оформить в виде процедуры).
2) Найти номер первого из столбцов, не содержащих ни одного отрицательного элемента (оформить в виде функции).
Дан рабочий код. Нужно его переделать так, чтобы все реализовалось с помощью процедур и функций.

program Project2;
var a:array[1..30,1..30] of integer;
    i,j,l,k,n,sum:integer;
    x,y,minus:integer;
    m:boolean;
begin
     WriteLn('Введите размер массива');
     WriteLn('Число строк:');
     ReadLn(x);
     WriteLn('Число столбцов:');
     ReadLn(y);
     
 
    for n:=1 to x do
    for i:=1 to y do
      begin
         Write('a[',n,',',i,']=');
         Readln(a[n,i]);
      end;
 
for n:=1 to x do
begin
  l:=1;
  sum:=0;
   for i:=1 to y do
     begin
        if i<>y then
          for j:=i+1 to y do
             if a[n,i]=a[n,j] then
               begin
                 m:=false;
                   if i<>1 then
                    begin
                     for k:=1 to i-1 do
                       if a[n,k]=a[n,i] then
                        m:=true;
                    end;
                  if m<>true then
                   l:=l+1;
               end;
       if l<>1 then
       sum:=sum+l;
       l:=1;
     end;
a[n,y+1]:=sum;
end;
 
for i:=1 to x-1 do
for j:=1 to x-1 do
  begin
    if a[j,y+1]>a[j+1,y+1] then
      begin
           for k:=1 to y+1 do
             begin
             a[x+1,k]:=a[j,k];
             a[j,k]:=a[j+1,k];
             a[j+1,k]:=a[x+1,k];
             end;
      end;
  end;
WriteLn;
    for n:=1 to x do
    for i:=1 to y do
      if i<>y then
        Write(a[n,i],' ')
      else
        WriteLn(a[n,i]);
WriteLn;
 
{тут находим положительный столбик}
    minus:=-1;
    i:=0;
     repeat
        i:=i+1;
         for n:=1 to x do
          begin
             if (a[n,i]<0) then
              minus:=i;
          end;
             if minus=-1 then
              begin
                 minus:=i;
                 i:=y;
              end
             else
              begin
                minus:=-1;
              end;
     until i=y;
   if minus<>-1 then
     WriteLn('Искомый столбец=',minus)
   else
     WriteLn('Такого нет');
ReadLn;
end.

[Flocky]

Данный тема все еще требует ответа.

[ViktorR]

Вот пример части задачи:

const nLin = 5;
      nCol = 5;
Type Tmas = array[1..nLin,1..nCol] of integer;

var Matr : Tmas;
       n : integer;

{
   Процедура инициализации прямоугольной матрицы
}
procedure MakeMatr(var mas : Tmas);
var i, j : integer;
    spec : integer;
begin
   spec := random(nCol) + 1;
   for i := 1 to nLin do
      for j := 1 to nCol do
         if j <> spec then
            mas[i,j] := random(500)-249
         else
            mas[i,j] := abs(random(500)-249);
end;

{
   Процедура выводит матрицу на экран
}
procedure TypeMatr(mas :Tmas);
var i, j : integer;
begin
   for i := 1 to nLin do
   begin
      for j := 1 to nCol do
         write(mas[i, j]:5, '  ');
      writeln;
   end;
end;


{
   Функция возвращает:
     0 - столбца только с положительными элементами нет
     n - номер первого столбца только с положительными элементами
}
function PlusCol(var mas : Tmas): integer;
var i, j : integer;
     flg : boolean;
begin
   PlusCol := 0;
   for i := 1 to nCol do {Двигаемся по столбцам}
   begin
      flg := true;
      for j := 1 to nLin do {Двигаемся по строкам}
         if mas[j, i] < 0 then {Встретили отрицательный элемент}
         begin
            flg := false;
            Break;   {Завершили текущий цикл}
         end;
      if flg then {Найден подходящий столбец}
      begin
         PlusCol := i;
         Break; {Завершили текущий цикл}
      end;
   end;
end;
BEGIN
   randomize;
   MakeMatr(Matr);
   TypeMatr(Matr);
   n := PlusCol(Matr);
   if n <> 0 then
      writeln('n = ', n:4)
   else
      writeln('Столбца только с положительными элементами нет!');
   readln;
END.

Оставшуюся часть надо постараться и сделать самому.
Так интересней ...


Как-то так, ...

[Flocky]

program laba5;
Type mas=array[1..5] of integer;
Var a: array[1..5, 1..5] of integer;
s, d:mas; {массив элементов одной строки и массив количеств одинаковых элементов в строках}
j,k,w, min, m,n :integer;
 
procedure kolich(b:mas; Var kol: integer); {кол-во одинаковых элементов с строке}
Var j, k, max :integer;
c:mas;
begin
for j:=1 to 5 do
begin
c[j]:=0;
for k:=1 to 5 do
if b[k]= b[j] then c[j]:=c[j]+1;
end;
max:=c[1];
for j:=2 to 5 do
if c[j]> max then max:=c[j];
kol:=max;
end; {конец процедуры}
 
Procedure obmen(Var x,y:integer); {для обмена местами элементов}
Var prom:integer;
begin
prom:=x;
x:=y;
y:=prom;
end; {конец процедуры}
 
 { 
Функция возвращает: 
0 - столбца только с положительными элементами нет 
n - номер первого столбца только с положительными элементами 
} 
function PlusCol(var b:mas): integer; 
var i, j : integer; 
flg : boolean; 
begin 
PlusCol := 0; 
for i := 1 to 5 do {Двигаемся по столбцам} 
begin 
flg := true; 
for j := 1 to 5 do {Двигаемся по строкам} 
if a[j, i] < 0 then {Встретили отрицательный элемент} 
begin 
flg := false; 
Break; {Завершили текущий цикл} 
end; 
if flg then {Найден подходящий столбец} 
begin 
PlusCol := i; 
Break; {Завершили текущий цикл} 
end; 
end; 
end; 
 
 
 
begin
writeln('Исходный массив ');
for j:=1 to 5 do
begin
for k:=1 to 5 do
begin
a [j, k ] := Random(10)-5;
write( a [ j,k ]:3,' ');
end;
writeln;
end;
 
for j:=1 to 5 do
begin
for k:=1 to 5 do
s [ k] := a [ j,k ]; {формирование матрицы из элементов строки};
kolich(s, d[j]);
writeln('Количество одинаковых элементов в ', j, ' строке= ', d[j]);
end;
 
{сортировка массива d и перестановка строк}
for j:=1 to 4 do
begin
min:=d[j]; m:=j;
for k:=j+1 to 5 do
if d[k]< min then begin min:=d[k]; m:=k end;
obmen(d[j],d[m]);
for w:=1 to 5 do {перестановка строк}
obmen(a[j,w],a[m,w]);
end;
 
writeln('матрица с переставленными строками в соответствии с ростом количества одинаковых элементов в строке: ');
for j:=1 to 5 do
begin
for k:=1 to 5 do
write( a[j,k]:3,' ');
writeln;
end;
 n := PlusCol(s);
   if n <> 0 then
      writeln('n = ', n:4)
   else
      writeln('Столбца только с положительными элементами нет!');
   readln;
end.