IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Помогите с процедурой...
сообщение
Сообщение #1


Гость






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

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

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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


The matrix has me!!!
**

Группа: Пользователи
Сообщений: 74
Пол: Мужской
Реальное имя: Евгений

Репутация: -  0  +


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


--------------------
"Брать производную можно научить даже обезьяну" - мой препод по матану! :-)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской

Репутация: -  0  +


Это понятно,но как реализовать это,не получается почему-то =(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

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


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской

Репутация: -  0  +


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

....
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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


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

Я так понимаю ar - это двумерный массив? тогда может стоит добавить второй индекс?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской

Репутация: -  0  +


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

Добавлено через 2 мин.
Двумерный он да...
Куда и чего добавить
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


у двумерного массива индексов два: ar[i,j], у тебя только один ar[j]..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской

Репутация: -  0  +



....
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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


The matrix has me!!!
**

Группа: Пользователи
Сообщений: 74
Пол: Мужской
Реальное имя: Евгений

Репутация: -  0  +


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


--------------------
"Брать производную можно научить даже обезьяну" - мой препод по матану! :-)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


mouse1 а можно полный код встудию? smile.gif
Цитата
у тебя ar - типа mas, а T - типа integer, вот и всё!

вот и ничего smile.gif Введи и скажи мне, где-нибудь комилятор говорит, что тип несовместим?
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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской

Репутация: -  0  +



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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


Получилось как-то так (я добавила функцию в процедуру сортировки):
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.

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

Сообщение отредактировано: Айра -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 14
Пол: Мужской

Репутация: -  0  +


Пасиб большое за помощь !
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






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

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

 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


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

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

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

Сообщение отредактировано: Айра -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






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


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


smile.gif Сама того не зная начала писать в новом для себя языке)) А где мне режим переключить можно?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






Меню Options -> Compiler -> Syntax -> Compiler mode установить в "Turbo Pascal Compatible"
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Профи
****

Группа: Пользователи
Сообщений: 731
Пол: Женский

Репутация: -  25  +


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

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 31.10.2020 16:01
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name