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

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

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

> Помогите, с программкой, В самом конце затруднение
сообщение
Сообщение #1


Пионер
**

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

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


Вот задание:
Латинский квадрат. Латинским квадратом пордка n называется квадратная таблица размером nxn каждая строка и каждый столбец которой содержит все числа от 1 до n. Проверить является ли заданная целочисленная матрица латинским квадратом.

const nmax=100;mmax=100;
type matrix=array [1..nmax,1..mmax] of real;
var k,i,j,n,m:integer;
x:real;
a:matrix;
f:boolean;
begin
writeln('Vvedite mashtab matrix');
read (n,m);
writeln('vvedite matrix');
for i:=1 to n do
for j:=1 to m do
read(a[i,j]);
begin
for i:=1 to n do
for k:=1 to n-1 do
begin
j:=1;
repeat {упорядочивает эл-ты каждой строки матрицы по возрастанию }
if a[i,j]>a[i,j+1] then
begin
x:=a[i,j+1];
a[i,j+1]:=a[i,j];
a[i,j]:=x;
j:=j+1;
end
else
j:=j+1
until (j=n);
end;
begin
writeln ('_____MATRICA_____');
for i:=1 to n do
begin
for j:=1 to m do
write(' ', a[i,j]);
writeln;
end;
f:=false;
j:=1;
for i:=1 to n do
for j:=1 to m do
if (m=n) and (a[i,j+1]-a[i,j]=1) then {Вот тута и проблемка если следующий эл-нт меньше
предыдущего на 1 то латинский квадрат иначне нет.
Но у мя че то не получается, а мозги уже отказываются думать =) }
f:=true;
if f then
writeln ('matrica Latinskii kvadrat')
else
writeln ('matrica ne latinskii kvadrat')
end;
end;
end.



Напишите плиз что там за проверочку в конце надо поставить =)

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


Пионер
**

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

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


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

const nmax=100;mmax=100;
type matrix=array [1..nmax,1..mmax] of real;
var k,i,j,n,m:integer;
x,y:real;
a,b:matrix;
f1,f2,t1,t2:boolean;
begin
writeln('Vvedite mashtab matrix n х m');
read (n,m);
t1:=true;
t2:=true;
if m<>n then
writeln ('Матрица не квадратная')
else
writeln('vvedite matrix');
for i:=1 to n do
for j:=1 to m do
read(a[i,j]);
b:=a;
begin
for i:=1 to n do
for k:=1 to n-1 do
begin
j:=1;
repeat{упорядочиваем элементы матрицы по строкам в порядке возрастания}
if a[i,j]>a[i,j+1] then
begin
x:=a[i,j+1];
a[i,j+1]:=a[i,j];
a[i,j]:=x;
j:=j+1;
end
else
j:=j+1
until (j=n);
end;
f1:=false;
for i:=1 to n do
begin
j:=1;
repeat
if (m=n) and (a[i,j+1]-a[i,j]=1) then
begin
f1:=true;
j:=j+1
end
else
begin
f1:=false;
{ j:=j+1 }
end;
if not f1 then
t1:=f1;
until not f1 or (j=n);
end;
begin
for j:=1 to n do
for k:=1 to n-1 do
begin
i:=1;
repeat{упорядочиваем элементы матрицы по столбцам в порядке возрастания}
if b[i,j]>b[i+1,j] then
begin
y:=b[i+1,j];
b[i+1,j]:=b[i,j];
b[i,j]:=y;
i:=i+1;
end
else
i:=i+1
until (i=n);
end;
f2:=false;
for j:=1 to n do
begin
i:=1;
repeat
if (m=n) and (b[i+1,j]-b[i,j]=1) then
begin
f2:=true;
i:=i+1
end
else
begin
f2:=false;
end;
if not f2 then
t2:=f2;
until not f2 or (i=n);
end;
if not t1 and not t2 or t1 and not t2 or not t1 and t2 then
writeln ('матрица не является латинским квадратом');
if t1 and t2 then
writeln ('матрица яв латинский квадрат')
end;
end;
end;
end;
end.



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

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


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

 





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