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

Помогите доделать прогу...Функция сделана,а вот процедура не получается

program matrica;
uses crt;
const
  max=10;
type
   mas=array[1..max,1..max] of integer;
var
   nmax,mmax:integer;
   m:mas;
   i,j:integer;
   function otr(var m:mas):integer;
   var
    found:boolean;
    d,t:integer;
    nom:integer;
     begin
       d:=0;
       t:=0;
       nom:=0;
       for j:=1 to mmax do
         begin
           d:=d+t;
           found:=false;
           for i:=1 to nmax do
             if m[i,j]<0 then
               begin
                 found:=true;
               end
             else nom:=j;
             if (found=false) and (d=0) then
               begin
                 t:=1;
                 writeln('Номер первого столбца в котором нет отрицателных чисел = ',nom);
               end;
         end;
       if (t=0) then writeln('Во всех столбцах матрицы присутствуют отрицательные числа.');
     end;
begin
  clrscr;
  writeln ('  Упорядочить строки целочисленной прямоугольной матрицы');
  writeln ('по возрастанию количества одинаковых элементов в каждой стоке; ');
  writeln ('найти номер первого из столбцов, не содержащий ни одного   ');
  writeln ('отрицательного элемента. ');
  writeln;
  repeat
    writeln('Введите размер прямоугольной матрицы:');
    write('n=');
    readln(nmax);
    write('m=');
    readln(mmax);
    if (nmax<=0) or (nmax>max) or (mmax<=0) or (mmax>max) then
      writeln('Ошибка! Размер матрицы не должен выходить за рамки 10х10.');
  until (nmax>0) and (nmax<=max) and (mmax>0) and (mmax<=max);
    for i:=1 to nmax do
      for j:=1 to nmax do
        begin
          write ('[',i,';',j,']=');
          readln(m[i,j]);
        end;
  writeln('_________________________________________________________');
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j],'  ');
        writeln;
      end;
  writeln('_________________________________________________________');
  otr(m);
  writeln('_________________________________________________________');
  writeln('Для выхода из программы нажмите Enter');
  readln;
end.

Суть процедуры в кратце: запусти по двойному циклу сортировку (можешь самую простую, пузырьком например), одновременно высчитывая количество одинаковых элементов в соседних строках, и сравнивай их, пока не отсортируешь...

Это понятно,но как реализовать это,не получается почему-то =(

1. Читаешь здесь: Как задать матрицу, чтобы быстро поменять местами ее строки ?
2. Задаешь матрицу так, как там написано
3. Пишешь функцию, вычисляющую количество одинаковых элементов в одной отдельно взятой строке (назовем ее F, к примеру)
4. Пишешь процедуру сортировки (как уже было сказано выше - хоть "пузырек"), но вместо сравнения самих строк матрицы сравниваешь результаты F(строка_i) и F(строка_i+1), а вот меняешь местами при необходимости - сами строки...

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

Вообщем,вставил этот код:

....
Procedure Bubble(Var ar: mas; n: integer);
Var i, j, T: Integer;
Begin
  For i := 1 To n Do
    For j := n DownTo i+1 Do
      If ar[Pred(j)] > ar[j] Then Begin { < }
        T := ar[Pred(j)]; ar[Pred(j)] := ar[j]; ar[j] := T
      End
End;
....

Выдаёт ошибку 41 Operand types do notmatch operator на строке If ar[Pred(j)] > ar[j] Then Begin

Я так понимаю ar - это двумерный массив? тогда может стоит добавить второй индекс?

Млин,чёта я не догоняю..

Добавлено через 2 мин.
Двумерный он да...
Куда и чего добавить

у двумерного массива индексов два: ar[i,j], у тебя только один ar[j]..

....
Procedure Bubble(Var ar: mas; n: integer);
Var i, j, T: Integer;
Begin
  For i := 1 To n Do
    For j := n DownTo i+1 Do
      If ar[Pred (i),(j)] > ar[i,j] Then
      Begin 
        T := ar[Pred(i),(j)]; 
       ar[Pred(i,j)] := ar[i,j];
        ar[i,j] := T;
      End
End;
....

ar[i,j] := T; -выдаёт Type mismatch

понятное дело выдаёт, несоответсвие типов, невооружённым глазом видно, что у тебя ar - типа mas, а T - типа integer, вот и всё!

mouse1 а можно полный код встудию?

вот и ничего Введи и скажи мне, где-нибудь комилятор говорит, что тип несовместим?

const n=5;
type mas= array[1..n,1..n] of integer;
Var i, j, T: Integer;
    ar: mas;
Begin
  For i := 1 To n Do
    For j := n DownTo i+1 Do
      If ar[Pred (i),j] > ar[i,j] Then
      Begin
         T := ar[Pred(i),(j)];
         ar[Pred(i),j] := ar[i,j];
         ar[i,j] := T;
      end;
end.

program proga;
uses crt;
const
  max=10;
type
   mas=array[1..max,1..max] of integer;
var
   nmax,mmax:integer;
   m:mas;
   i,j,n:integer;
   function otr(var m:mas):integer;
   var
    found:boolean;
    d,t:integer;
    nom:integer;
     begin
       d:=0;
       t:=0;
       nom:=0;
       for j:=1 to mmax do
         begin
           d:=d+t;
           found:=false;
           for i:=1 to nmax do
             if m[i,j]<0 then
               begin
                 found:=true;
               end
             else nom:=j;
             if (found=false) and (d=0) then
               begin
                 t:=1;
                 writeln('Номер первого столбца в котором нет отрицателных чисел = ',nom);
               end;
         end;
       if (t=0) then writeln('Во всех столбцах матрицы присутствуют отрицательные числа.');
     end;
     Procedure bubble (Var m:mas);
      Var
       t:integer;
      begin
        For i:=1 to nmax do
        for j:=1 downto I+1 do
         begin
         if m[Pred(i),(j)]<m[i,j] then
         begin
          t:=m[Pred (i),(j)];
         m[Pred (i),(j)]:=m[i,j];
         m[i,j]:=t;
         write(m[i,j]:3);
         end;
         writeln
         end;
      end;
begin
  clrscr;
  writeln ('  Упорядочить строки целочисленной прямоугольной матрицы');
  writeln ('по возрастанию количества одинаковых элементов в каждой стоке; ');
  writeln ('найти номер первого из столбцов, не содержащий ни одного   ');
  writeln ('отрицательного элемента. ');
  writeln;
  repeat
    writeln('Введите размер прямоугольной матрицы:');
    write('n=');
    readln(nmax);
    write('m=');
    readln(mmax);
    if (nmax<=0) or (nmax>max) or (mmax<=0) or (mmax>max) then
      writeln('Ошибка! Размер матрицы не должен выходить за рамки 10х10.');
  until (nmax>0) and (nmax<=max) and (mmax>0) and (mmax<=max);
    for i:=1 to nmax do
      for j:=1 to mmax do
        begin
          write ('[',i,';',j,']=');
          readln(m[i,j]);
        end;
  writeln('_________________________________________________________');
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j],'  ');
        writeln;
      end;
  writeln('_________________________________________________________');
  otr(m);
  writeln('_________________________________________________________');
  bubble (m);
  writeln('Для выхода из программы нажмите Enter');
  readln;
end.

  

Вот что получилось,матрицу не упорядочивается,хэлп..сёдня нужно.. =(

Получилось как-то так (я добавила функцию в процедуру сортировки):

program proga;
uses crt;
const
  max=10;
type
  str = array[1..max] of integer;
  mas=array[1..max] of str;
var
   nmax,mmax:integer;
   m: mas;
   i,j,n:integer;
   function otr(var m:mas):integer;
   var
    found:boolean;
    d,t:integer;
    nom:integer;
     begin
       d:=0;
       t:=0;
       nom:=0;
       for j:=1 to mmax do
         begin
           d:=d+t;
           found:=false;
           for i:=1 to nmax do
             if m[i,j]<0 then
               begin
                 found:=true;
               end
             else nom:=j;
             if (found=false) and (d=0) then
               begin
                 t:=1;
                 writeln('Номер первого столбца в котором нет отрицателных чисел = ',nom);
               end;
         end;
       if (t=0) then writeln('Во всех столбцах матрицы присутствуют отрицательные числа.');
     end;

  Procedure bubble (Var m: mas);
  Var t: str; //массив, который будет равен i-й строке матрицы
    function kol(s: str): integer;  //нахождение количества одинаковых
    var v,w,k,kmax,x: integer;
    begin
      kmax:=0;
      for v:=1 to mmax do
        begin
          k:=1;
          x:=s[v];
          for w:=v+1 to mmax do if s[w]=x then inc(k);
          if k>kmax then kmax:=k;
        end;
      kol:=kmax;
    end;
  begin //начало процедуры
    for i:=2 to nmax do
      for j:=nmax downto i do
        if kol(m[j])<kol(m[j-1]) then
          begin
            t:=m[j];
            m[j]:=m[j-1];
            m[j-1]:=t;
          end;
  end;

begin
  clrscr;
  writeln ('  Упорядочить строки целочисленной прямоугольной матрицы');
  writeln ('по возрастанию количества одинаковых элементов в каждой стоке; ');
  writeln ('найти номер первого из столбцов, не содержащий ни одного   ');
  writeln ('отрицательного элемента. ');
  writeln;
  repeat
    writeln('Введите размер прямоугольной матрицы:');
    write('n=');
    readln(nmax);
    write('m=');
    readln(mmax);
    if (nmax<=0) or (nmax>max) or (mmax<=0) or (mmax>max) then
      writeln('Ошибка! Размер матрицы не должен выходить за рамки 10х10.');
  until (nmax>0) and (nmax<=max) and (mmax>0) and (mmax<=max);
    for i:=1 to nmax do
      for j:=1 to mmax do
        begin
write ('[',i,';',j,']=');
          readln(m[i,j]);
        end;
  writeln('_________________________________________________________');
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j]:4);
        writeln;
      end;
  writeln('_________________________________________________________');
  otr(m);
  writeln('_________________________________________________________');
  bubble (m);
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j]:4);
        writeln;
      end;
  writeln('_________________________________________________________');
  writeln('Для выхода из программы нажмите Enter');
  readln;
end.

Вроде работает, но хорошо проверить времени нет..

Пасиб большое за помощь !

Оля, ты на каком компиляторе это проверяла? При заданном тобой описании типов mas и str программа выдает ошибку при компиляции как на TP, так и в некоторых других компиляторах. Чтобы этого не было - типы надо переопределить так:

type
  str = array[1..max] of integer;
  mas=array[1..max] of str;

сейчас вижу, что ерунда с типами, но эта ерунда не только компилируется на FPS, но и работает Сейчас исправлю..

p.s. чувствую хватит мне по ночам программки писать.. надо концентрироваться на матане)))

Добавлено через 3 мин.
проверила сейчас в TPW - выдает ошибку "тип не совместим".. Может что-то с настройками FPC?

Ничего особенного... В режиме {$mode objFPC} это действительно будет работать (то, что ты написала), только это Extended Pascal... В обычном (или Object) Паскале надо делать так, как написано в посте №15.

Сама того не зная начала писать в новом для себя языке)) А где мне режим переключить можно?

Меню Options -> Compiler -> Syntax -> Compiler mode установить в "Turbo Pascal Compatible"

Пасибо.. поменяла, теперь программка гордо не работает))
А вообще от того "расширенного паскаля" какую выгоду можно было получить?

Ну, посмотри вот тут: Сравнение Borland Pascal со стандартами - там указаны отличия... Можно и выгоду найти... При желании

За ссылку пасибо, буду изучать)) (p.s. загнать текст в переводчик побоялась, придется старым добрым методом со словариком))))

Повременил я с благодарствами =)

С утра не успел проверить,в инст пришёл и опана...

Ты про это

эм,он строки местами меняет тока кажись...

Скажи пример, на каком неправильно отработало

Там несоответствие типов было,а сейчас он не сортирует... Прост отображается точно такая же матрица 2-ой раз...
n=3
m=3
[1,1]=1
[1,2]=3
[1,3]=2
[2,1]=5
[2,2]=5
[2,3]=5
[3,1]=2
[3,2]=2
[3,3]=1
Про отриц элементы в матрице всё правильно выдаёт

1 3 2
5 5 5
2 2 1

Номер первого столбца, в котором нет отриц элементов=1

а дальше должен отсортировать строки по возрастанию количества одинаковых элементов

5 5 5
2 2 1
1 3 2

А ты пишешьНадо ведь так:
1 3 2
2 2 1
5 5 5

упс...ну да

Тогда надо изменить процедуру bubble

for i:=1 to nmax do
      for j:=nmax downto i do
        if kol(m[i])>kol(m[j]) then
          begin
            t:=m[j];
            m[j]:=m[i];
            m[i]:=t;
          end;

Вроде на всех примерах отработала

вставил,type mismatch выдаёт

Надо же, несовпадение типов, ты хоть скажи где именно, и еще покажи ВЕСЬ код, куда и как ты это вставил

program proga;
uses crt;
const
  max=10;
type
  mas=array[1..max,1..max] of integer;
  str = array[1..max] of integer;
var
   nmax,mmax:integer;
   m: mas;
   i,j,n:integer;
   function otr(var m:mas):integer;
   var
    found:boolean;
    d,t:integer;
    nom:integer;
     begin
       d:=0;
       t:=0;
       nom:=0;
       for j:=1 to mmax do
         begin
           d:=d+t;
           found:=false;
           for i:=1 to nmax do
             if m[i,j]<0 then
               begin
                 found:=true;
               end
             else nom:=j;
             if (found=false) and (d=0) then
               begin
                 t:=1;
                 writeln('Номер первого столбца в котором нет отрицателных чисел = ',nom);
               end;
         end;
       if (t=0) then writeln('Во всех столбцах матрицы присутствуют отрицательные числа.');
     end;

  Procedure bubble (Var m: mas);
  Var t: str; //массив, который будет равен i-й строке матрицы
    function kol(s: str): integer;  //нахождение количества одинаковых
    var v,w,k,kmax,x: integer;
    begin
      kmax:=0;
      for v:=1 to mmax do
        begin
          k:=1;
          x:=s[v];
          for w:=v+1 to mmax do if s[w]=x then inc(k);
          if k>kmax then kmax:=k;
        end;
      kol:=kmax;
    end;
  begin //начало процедуры
    for i:=1 to nmax do
      for j:=nmax downto i do
        if kol(m[i])>kol(m[j]) then
          begin
            t:=m[j];
            m[j]:=m[i];
            m[i]:=t;
          end;
  end;

begin
  clrscr;
  writeln ('  Упорядочить строки целочисленной прямоугольной матрицы');
  writeln ('по возрастанию количества одинаковых элементов в каждой стоке; ');
  writeln ('найти номер первого из столбцов, не содержащий ни одного   ');
  writeln ('отрицательного элемента. ');
  writeln;
  repeat
    writeln('Введите размер прямоугольной матрицы:');
    write('n=');
    readln(nmax);
    write('m=');
    readln(mmax);
    if (nmax<=0) or (nmax>max) or (mmax<=0) or (mmax>max) then
      writeln('Ошибка! Размер матрицы не должен выходить за рамки 10х10.');
  until (nmax>0) and (nmax<=max) and (mmax>0) and (mmax<=max);
    for i:=1 to nmax do
      for j:=1 to mmax do
        begin
write ('[',i,';',j,']=');
          readln(m[i,j]);
        end;
  writeln('_________________________________________________________');
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j]:4);
        writeln;
      end;
  writeln('_________________________________________________________');
  otr(m);
  writeln('_________________________________________________________');
  bubble (m);
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j]:4);
        writeln;
      end;
  writeln('_________________________________________________________');
  writeln('Для выхода из программы нажмите Enter');
  readln;
end.

if kol(m[i])>kol(m[j]) then

здесь выдаёт

Если ты еще не понял в чем ошибка, то читай пост #15

Всё..понял..исправил !

program proga;
uses crt;
const
  max=10;
type
  str = array[1..max] of integer;
  mas=array[1..max] of str;
var
   nmax,mmax:integer;
   m: mas;
   i,j,n:integer;
   function otr(var m:mas):integer;
   var
    found:boolean;
    d,t:integer;
    nom:integer;
     begin
       d:=0;
       t:=0;
       nom:=0;
       for j:=1 to mmax do
         begin
           d:=d+t;
           found:=false;
           for i:=1 to nmax do
             if m[i,j]<0 then
               begin
                 found:=true;
               end
             else nom:=j;
             if (found=false) and (d=0) then
               begin
                 t:=1;
                 writeln('Номер первого столбца в котором нет отрицателных чисел = ',nom);
               end;
         end;
       if (t=0) then writeln('Во всех столбцах матрицы присутствуют отрицательные 

числа.');
     end;

  Procedure bubble (Var m: mas);
  Var t: str; {массив, который будет равен i-й строке матрицы}
    function kol(s: str): integer;  {нахождение количества одинаковых}
    var v,w,k,kmax,x: integer;
    begin
      kmax:=0;
      for v:=1 to mmax do
        begin
          k:=1;
          x:=s[v];
          for w:=v+1 to mmax do if s[w]=x then inc(k);
          if k>kmax then kmax:=k;
        end;
      kol:=kmax;
    end;
  begin {начало процедуры}
    for i:=1 to nmax do
      for j:=nmax downto i do
        if kol(m[i])>kol(m[j]) then
          begin
            t:=m[j];
            m[j]:=m[i];
            m[i]:=t;
          end;
  end;

begin
  clrscr;
  writeln ('  Упорядочить строки целочисленной прямоугольной матрицы');
  writeln ('по возрастанию количества одинаковых элементов в каждой стоке; ');
  writeln ('найти номер первого из столбцов, не содержащий ни одного   ');
  writeln ('отрицательного элемента. ');
  writeln;
  repeat
    writeln('Введите размер прямоугольной матрицы:');
    write('n=');
    readln(nmax);
    write('m=');
    readln(mmax);
    if (nmax<=0) or (nmax>max) or (mmax<=0) or (mmax>max) then
      writeln('Ошибка! Размер матрицы не должен выходить за рамки 10х10.');
  until (nmax>0) and (nmax<=max) and (mmax>0) and (mmax<=max);
    for i:=1 to nmax do
      for j:=1 to mmax do
        begin
write ('[',i,';',j,']=');
          readln(m[i,j]);
        end;
  writeln('_________________________________________________________');
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j]:4);
        writeln;
      end;
  writeln('_________________________________________________________');
  otr(m);
  writeln('_________________________________________________________');
  bubble (m);
  writeln('полученная матрица');
    for i:=1 to nmax do
      begin
        for j:=1 to mmax do
          write (m[i,j]:4);
        writeln;
      end;
  writeln('_________________________________________________________');
  writeln('Для выхода из программы нажмите Enter');
  readln;
end.

Tnx everybody !!

Странно, но у меня прежний вариант сортирует нормально..
to mouse1 за "тип несовместим" сорри((( уже разобрали, почему у меня работало.. Ну хоть сдать еще есть возможность?

Да,20 пойду ! Сёравно ещё другая прога не сделана,прост хотел облегчить себе учесть...