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

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

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

> неубывание и убывание строк матриц, помогите исправить программу
сообщение
Сообщение #1





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

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


Вот условие:
Даны 2 матрицы действительной размерности. Упорядочить элементы строк матрицы по невозрастанию, если модуль среднего арифметического отрицательных элементов меньше предпоследнего элемента строки, а иначе упорядочить по неубыванию.
Вот я пробовал решать:
Код
Program kur;
type vect=array[1..7,1..7] of integer;  
var b,c:vect;  
rv1,rv2,rh1,rh2,i,j,m,s,k,p:integer;  
s1:real;  
procedure vvod(var a:vect;n,m:integer);  
begin  for i:=1 to n do  
for j:=1 to m do  
read(a[i,j]);  
end;  
procedure proc(var a:vect;n,m:integer);  
label 50;
begin  
  for i:=1 to n do
begin  
for j:=1 to m do  
if a[i,j]<0 then  
begin
s1:=s1+a[i,j];
k:=k+1;  
end;
if k<>0 then
begin  
if abs(s1/k)<a[i,m-1] then  
begin  for j:=1 to m-1 do
begin  
s:=k;
for k:=j to m do  
if a[i,j]<a[i,s] then  
s:=k;p:=a[i,j];
a[i,j]:=a[i,s];
a[i,s]:=p;
end;  
end;  
end;
goto 50;  
for j:=1 to m-1  do
begin
s:=k;
for k:=j to m do
if a[i,j]>a[i,s] then
s:=k;  
p:=a[i,j];
a[i,j]:= a[i,s];
a[i,s]:=p;  
end;  
50 :;i:=i;
end;  
end;  
procedure vyvod(var a:vect;n,m:integer);  
begin  
for i:=1 to n do
for j:=1 to m do
write(a[i,j],' ');
writeln;  
end;  
begin
read(rv1,rh1);
  read(rv2,rh2);
vvod(b,rv1,rh1);
  vvod(c,rv2,rh2);
proc(b,rv1,rh1);
proc(c,rv2,rh2);  
vyvod(b,rv1,rh1);  
vyvod(c,rv2,rh2);  
end.  


А вот мне помогали:
Код

program kursovaya;  
type vect=array[1..7,1..7] of integer;
var bm,cm:vect;
rv1,rh1,rv2,rh2,i,i1,j,k,p,s,aq,bq,q,x:integer;
procedure proc(var a:vect;var h,v:integer);  
var b :array [1..7] of real;
begin  
for j:=1 to v do
begin  
q:=0;
for i:=1 to h do  
if a[i,j]<0 then
begin
q:=q+a[i,j];
x:=x+1;
end;  
if q<>0 then
b[j]:=abs(q/x);  
end;  
for i1:=1 to v do
begin  
if a[h-1,i1]<b[i1] then    
for i:=1 to h-1 do  
begin  
k:=i;  
for j:=i to h do  
if a[k,i1]>a[j,i1] then
k:=j;  
p:=a[k,i1];  
a[k,i1]:=a[i,i1];  
a[i,i1]:=p;  
end  
else  
for i:=1 to h-1 do  
begin  
k:=i;  
for j:=i to h do
if a[k,i1]<a[j,i1] then
k:=j;  
p:=a[k,i1];  
a[k,i1]:=a[i,i1];  
a[i,i1]:=p;  
end;    
end;  
end;  
procedure vvod(var f:vect;var h,v:integer);
begin
for i:=1 to v do
for j:=1 to h do
read(f[j,i]);  
end;  
procedure vyvod(var f:vect;var  h,v:integer);  
begin  
for i:=1 to v do  
begin
for j:=1 to h do  
write(f[j,i]);  
writeln;  
end;  
end;
begin  
read(rv1,rh1);  
read(rv2,rh2);  
vvod(bm,rv1,rh1);  
vvod(cm,rv2,rh2);  
proc(bm,rv1,rh1);  
proc(cm,rv2,rh2);  
vyvod(bm,rv1,rh1);  
vyvod(cm,rv2,rh2);    
end.    

но не одна из них правильно не работае. Прошу помогите кто чем может, или скажите что не так в них. Буду очень благодарен.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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