Помогите с процедурой... Опции

[Mouse]

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

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

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.

[Yevgeny]

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

[mouse1]

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

[volvo]

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

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

[mouse1]

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

....
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

[Айра]

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

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

[mouse1]

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

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

[Айра]

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

[mouse1]

....
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


Сообщение отредактировано: mouse1 - 17.01.2008 3:07

[Yevgeny]

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

[Айра]

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

у тебя ar - типа mas, а T - типа integer, вот и всё!

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

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.

[mouse1]

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.

  

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

Сообщение отредактировано: mouse1 - 17.01.2008 3:52

[Айра]

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

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.

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

Сообщение отредактировано: Айра - 17.01.2008 10:38

[mouse1]

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

[volvo]

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

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

[Айра]

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

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

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

Сообщение отредактировано: Айра - 17.01.2008 10:48

[volvo]

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

[Айра]

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

[volvo]

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

[Айра]

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