Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Латинский Квадрат
Автор: tricker 7.11.2003 16:05
Люди помогите !!!
Мне срочно до завтра необходимо написать программу «Латинский квадрат». Суть в том что если Вы вводите число 5 то строится матрица вида
1 2 3 4 5
2 3 4 5 1
3 4 5 1 2
4 5 1 2 3
5 1 2 3 4
И так далее, я написал половину программы и у меня строится матрица вида,
1 2 3 4 5
2 3 4 5 1
3 4 5 0 2
4 5 0 0 3
5 0 0 0 4
а дальше не могу написать . Я могу выслать текст программы что бы кто – нибудь дописал мне ее, т.к. я не могу ее доделать.
Автор: Serega 7.11.2003 19:39
Вот мое решение.
program lat_kv;
uses crt;
var a:array[1..100,1..100] of integer;
i,j,n:integer;
begin
clrscr;
write('Введите размер ');
readln(n);
for i:=1 to n do
for j:=1 to n do
begin
a[i,j]:=j+i-1;
if a[i,j]>n then a[i,j]:=a[i,j]-n;
end;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
readln;
end.
Автор: -=BR@BUS=- 8.12.2006 2:15
А как сделать, чтобы программа определяла является ли введёная матрица - латинским квадратом?
Автор: volvo 8.12.2006 2:41
Я бы сделал так:
const
{ Для проверки }
n = 4;
a: array[1 .. n, 1 .. n] of integer = (
(1, 2, 3, 4),
(2, 3, 4, 1),
(3, 4, 1, 2),
(4, 1, 2, 3)
);
var
value, i, j, s, sum, check: integer;
elems: set of byte;
ok, is_col: boolean;
begin
s := 0;
for i := 1 to n do s := s + i;
ok := true;
for is_col := false to true do begin
i := 1;
while (i <= n) and ok do begin
sum := 0; elems := [];
for j := 1 to n do begin
if is_col then value := a[j, i]
else value := a[i, j];
sum := sum + value;
elems := elems + [value];
end;
ok := ((sum = s) and (elems = [1 .. n]));
inc(i);
end;
end;
if ok then writeln('Yes')
else writeln('No');
end.
Автор: -=BR@BUS=- 8.12.2006 3:27
ВОТ СПАСИБО!!! 
Автор: -=BR@BUS=- 15.12.2006 22:02
А как сделать без "set of byte" а то мне нельзя с ней.
И если можно немного разъяснить принцип роботы этой программы...
Автор: Malice 16.12.2006 2:53
А вот так попробуй:
var i,j:integer;
b:boolean;
begin
b:=true;
for i:=0 to n-1 do
for j:=0 to n-1 do
b:=b and (((i*(n+1)+j) mod n)+1=a[j+1,i+1]);
if b then writeln ('ok');
end.
Автор: -=BR@BUS=- 16.12.2006 4:46
Вот такую матрицу
1 2 3
2 3 1
3 1 2
программа распознаёт, а вот эту
1 2 3
3 1 2
2 3 1
уже не распознаёт...
Автор: Malice 16.12.2006 5:03
Может по тому, что это совсем другая матрица, заполненная по другому принципу ?
Автор: -=BR@BUS=- 16.12.2006 16:05
Но ведь эта матрица тоже является латинским квадратом
Автор: volvo 16.12.2006 16:34
constВот и все... Так устроит?
(*
n = 4;
a: array[1 .. n, 1 .. n] of integer = (
(1, 2, 3, 4),
(2, 3, 4, 1),
(3, 4, 1, 2),
(4, 1, 2, 3)
);
*)
n = 3;
a: array[1 .. n, 1 .. n] of integer = (
(1, 2, 3),
(3, 1, 2),
(2, 3, 1)
);
type
{ Это - вместо того множества, которое было раньше }
vector = array[1 .. n] of integer;
var
elems: vector;
value, i, j, k, s, sum, check: integer;
ok, is_col: boolean;
begin
s := 0;
{
Вначале считаем сумму, которая должна получаться в каждом столбце/строке
(согласно определению латинского квадрата)
}
for i := 1 to n do s := s + i;
ok := true; { изначально считаем, что все в порядке }
{ вначале (is_col = false) проходим по строкам, потом (когда is_col = true) - по столбцам }
for is_col := false to true do begin
i := 1;
{
здесь цикл заменен на While, чтобы при нахождении ошибки сразу же
закончить просмотр строк/столбцов, если была хоть одна ошибка, то это - уже
НЕ латинский квадрат
}
while (i <= n) and ok do begin
sum := 0; { обнуляем сумму для данной строки/столбца, и наше "псевдомножество" }
for k := 1 to n do elems[k] := 0;
for j := 1 to n do begin
{
теперь выбираем текущий элемент (в зависимости от того, со строками
или столбцами мы работаем, индексы меняются местами)
}
if is_col then value := a[j, i]
else value := a[i, j];
{ добавляем элемент к текущей сумме строки/столбца }
sum := sum + value;
{
если элемент находится в допустимых границах (1 .. N)
и до этого в данном столбце/строке еще не встречался,
то записываем его, как уже встреченный, иначе - ошибка
(либо одно и то же число встречается в строке больше одного раза,
либо число больше N или меньше единицы, что тоже недопустимо)
}
if (value > 0) and (value <= n) and (elems[value] = 0) then
inc(elems[value])
else ok := false;
end;
{ Ну, и проверяем еще сумму на ошибочность - отличается ли она от "эталонной" }
ok := (ok and (sum = s));
inc(i);
end;
end;
if ok then writeln('Yes')
else writeln('No');
end.
Автор: -=BR@BUS=- 21.12.2006 23:05
Вот чё в итоге у меня получилось, но программа всегда отвечает НЕТ
Program Lat_kv;
Uses crt;
type
vector = array[1 .. 100] of integer;
var
elems: vector;
n,value, i, j, k, s, sum, check: integer;
ok, is_col: boolean;
A:Array[1..100,1..100] of integer;
begin
clrscr;
Writeln ('Введите ранг матрицы');
readln (n);
Writeln ('Введите элементы матрицы через <ENTER>');
For i:=1 to n do
For j:=1 to n do
readln (a[i,j]);
s := 0;
for i := 1 to n do s := s + i;
ok := true;
for is_col := false to true do begin
i := 1;
while (i <= n) and ok do begin
sum := 0;
for k := 1 to n do elems[k] := 0;
for j := 1 to n do begin
if is_col then value := a[j, i]
else value := a[i, j];
sum := sum + value;
if (value > 0) and (value <= n) and (elems[value] = 0) then
inc(elems[value])
else ok := false;
end;
ok := (ok and (sum = s));
inc(i);
end;
end;
if ok then writeln('Yes')
else writeln('No');
readln;
end;
end.
ПОЧЕМУ???
Автор: volvo 21.12.2006 23:08
Я тебе привел рабочую программу, которая давала правильный ответ... Ты ее исправлял? Тогда чего спрашиваешь? Разбирайся, ЧТО, ГДЕ и, главное, ЗАЧЕМ исправлял?
Автор: -=BR@BUS=- 21.12.2006 23:13
Мне нужно чтобы матрица вводилась во время выполнения программы, а не чтобы она была задана в конст.
Автор: мисс_граффити 21.12.2006 23:30
не умеешь писать ввод матрицы?
Автор: volvo 21.12.2006 23:34
sum := 0; { обнуляем сумму для данной строки/столбца, и наше "псевдомножество" }
for k := 1 to n do elems[k] := 0; { <--- Вот эту строку, например ... }
... я, по-твоему, для красоты напечатал? По какому праву ты ее убрал, и как хочешь, чтобы программа БЕЗ нее правильно работала?
Автор: -=BR@BUS=- 21.12.2006 23:43
Как всегда => верно volvo