Помощь - Поиск - Пользователи - Календарь
Полная версия: Латинский Квадрат
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
tricker
Люди помогите !!!
Мне срочно до завтра необходимо написать программу «Латинский квадрат». Суть в том что если Вы вводите число 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
Вот мое решение.

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=-
А как сделать, чтобы программа определяла является ли введёная матрица - латинским квадратом?
volvo
Я бы сделал так:
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=-
ВОТ СПАСИБО!!! good.gif
-=BR@BUS=-
А как сделать без "set of byte" а то мне нельзя с ней.
И если можно немного разъяснить принцип роботы этой программы...
Malice
А вот так попробуй:
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=-
Вот такую матрицу
1 2 3
2 3 1
3 1 2
программа распознаёт, а вот эту
1 2 3
3 1 2
2 3 1
уже не распознаёт...
Malice
Может по тому, что это совсем другая матрица, заполненная по другому принципу ?
-=BR@BUS=-
Но ведь эта матрица тоже является латинским квадратом
volvo
Цитата
А как сделать без "set of byte" а то мне нельзя с ней.
Вот так:

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=-
Вот чё в итоге у меня получилось, но программа всегда отвечает НЕТ

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
Я тебе привел рабочую программу, которая давала правильный ответ... Ты ее исправлял? Тогда чего спрашиваешь? Разбирайся, ЧТО, ГДЕ и, главное, ЗАЧЕМ исправлял?
-=BR@BUS=-
Мне нужно чтобы матрица вводилась во время выполнения программы, а не чтобы она была задана в конст.
мисс_граффити
не умеешь писать ввод матрицы?
volvo
      sum := 0; { обнуляем сумму для данной строки/столбца, и наше "псевдомножество" }
for k := 1 to n do elems[k] := 0; { <--- Вот эту строку, например ... }

... я, по-твоему, для красоты напечатал? По какому праву ты ее убрал, и как хочешь, чтобы программа БЕЗ нее правильно работала?
-=BR@BUS=-
mega_chok.gif Как всегда => верно volvo
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.