Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Помогите с процедурой...
Автор: Mouse 17.01.2008 1:17
Упорядочить строки целочисленной прямоугольной матрицы по возрастанию количества одинаковых элементов в каждой строке(в виде процедуры)
найти номер первого из столбцов, не содержащих ни одного отриц элемента(в виде ф-ии)
Помогите доделать прогу...Функция сделана,а вот процедура не получается
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 17.01.2008 2:58
Суть процедуры в кратце: запусти по двойному циклу сортировку (можешь самую простую, пузырьком например), одновременно высчитывая количество одинаковых элементов в соседних строках, и сравнивай их, пока не отсортируешь... 
Автор: mouse1 17.01.2008 3:25
Это понятно,но как реализовать это,не получается почему-то =(
Автор: volvo 17.01.2008 3:55
1. Читаешь здесь: http://volvo71.narod.ru/faq_folder/matrices.htm#mx_chng_line
2. Задаешь матрицу так, как там написано
3. Пишешь функцию, вычисляющую количество одинаковых элементов в одной отдельно взятой строке (назовем ее F, к примеру)
4. Пишешь процедуру сортировки (как уже было сказано выше - хоть "пузырек"), но вместо сравнения самих строк матрицы сравниваешь результаты F(строка_i) и F(строка_i+1), а вот меняешь местами при необходимости - сами строки...
Как видишь - ничего сложного, в поиске можно найти уже готовую реализацию, но я бы рекомендовал тебе сделать это задание самостоятельно (хотя бы начни, что не получится - поможем)...
Автор: mouse1 17.01.2008 6:04
Вообщем,вставил этот код:
....
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
Автор: Айра 17.01.2008 6:20
Я так понимаю ar - это двумерный массив? тогда может стоит добавить второй индекс?
Автор: mouse1 17.01.2008 6:25
Млин,чёта я не догоняю..
Добавлено через 2 мин.
Двумерный он да...
Куда и чего добавить
Автор: Айра 17.01.2008 6:37
у двумерного массива индексов два: ar[i,j], у тебя только один ar[j]..
Автор: mouse1 17.01.2008 6:53
....
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
Автор: Yevgeny 17.01.2008 7:24
понятное дело выдаёт, несоответсвие типов, невооружённым глазом видно, что у тебя ar - типа mas, а T - типа integer, вот и всё!
Автор: Айра 17.01.2008 7:48
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.
Автор: mouse1 17.01.2008 7:52
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.
Вот что получилось,матрицу не упорядочивается,хэлп..сёдня нужно.. =(
Автор: Айра 17.01.2008 9:31
Получилось как-то так (я добавила функцию в процедуру сортировки):
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.
Вроде работает, но хорошо проверить времени нет..
Автор: mouse1 17.01.2008 11:47
Пасиб большое за помощь !
Автор: volvo 17.01.2008 13:37
Оля, ты на каком компиляторе это проверяла? 
При заданном тобой описании типов mas и str программа выдает ошибку при компиляции как на TP, так и в некоторых других компиляторах. Чтобы этого не было - типы надо переопределить так:
type
str = array[1..max] of integer;
mas=array[1..max] of str;
Автор: Айра 17.01.2008 14:41
сейчас вижу, что ерунда с типами, но эта ерунда не только компилируется на FPS, но и работает Сейчас исправлю..
p.s. чувствую хватит мне по ночам программки писать.. надо концентрироваться на матане)))
Добавлено через 3 мин.
проверила сейчас в TPW - выдает ошибку "тип не совместим".. Может что-то с настройками FPC?
Автор: volvo 17.01.2008 14:48
Ничего особенного... В режиме {$mode objFPC} это действительно будет работать (то, что ты написала), только это Extended Pascal... В обычном (или Object) Паскале надо делать так, как написано в посте №15.
Автор: Айра 17.01.2008 14:51
Сама того не зная начала писать в новом для себя языке)) А где мне режим переключить можно?
Автор: volvo 17.01.2008 15:22
Меню Options -> Compiler -> Syntax -> Compiler mode установить в "Turbo Pascal Compatible"
Автор: Айра 17.01.2008 15:28
Пасибо.. поменяла, теперь программка гордо не работает))
А вообще от того "расширенного паскаля" какую выгоду можно было получить?
Автор: volvo 17.01.2008 15:49
Ну, посмотри вот тут: http://pascal-central.com/extpascal.html#anchor-6 - там указаны отличия... Можно и выгоду найти... При желании
Автор: Айра 17.01.2008 16:02
За ссылку пасибо, буду изучать)) (p.s. загнать текст в переводчик побоялась, придется старым добрым методом со словариком))))
Автор: mouse1 18.01.2008 1:17
Повременил я с благодарствами =)
С утра не успел проверить,в инст пришёл и опана...
Автор: Client 18.01.2008 1:23
Ты про это
Эскизы прикрепленных изображений
Автор: mouse1 18.01.2008 1:56
эм,он строки местами меняет тока кажись...
Автор: Client 18.01.2008 2:00
Автор: mouse1 18.01.2008 2:14
Там несоответствие типов было,а сейчас он не сортирует... Прост отображается точно такая же матрица 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
Автор: Client 18.01.2008 2:24
2 2 1
1 3 2
1 3 2
2 2 1
5 5 5
Автор: mouse1 18.01.2008 2:26
упс...ну да 
Автор: Client 18.01.2008 2:29
Тогда надо изменить процедуру 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;
Автор: mouse1 18.01.2008 2:54
вставил,type mismatch выдаёт
Автор: Client 18.01.2008 2:56
Надо же, несовпадение типов, ты хоть скажи где именно, и еще покажи ВЕСЬ код, куда и как ты это вставил 
Автор: mouse1 18.01.2008 2:59
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здесь выдаёт
Автор: Client 18.01.2008 3:03
Если ты еще не понял в чем ошибка, то читай пост #15
Автор: mouse1 18.01.2008 3:11
Всё..понял..исправил !
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 !!
Автор: Айра 18.01.2008 3:59
Странно, но у меня прежний вариант сортирует нормально..
to mouse1 за "тип несовместим" сорри((( уже разобрали, почему у меня работало.. Ну хоть сдать еще есть возможность?
Автор: mouse1 18.01.2008 4:22
Да,20 пойду ! Сёравно ещё другая прога не сделана,прост хотел облегчить себе учесть...