Латинский Квадрат Опции

[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=-]

А как сделать, чтобы программа определяла является ли введёная матрица - латинским квадратом?

Сообщение отредактировано: -=BR@BUS=- - 7.12.2006 22:20

[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=-]

ВОТ СПАСИБО!!!

[-=BR@BUS=-]

А как сделать без "set of byte" а то мне нельзя с ней.
И если можно немного разъяснить принцип роботы этой программы...

Сообщение отредактировано: -=BR@BUS=- - 15.12.2006 21:02

[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.

Сообщение отредактировано: Malice - 15.12.2006 22:53

[-=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.

ПОЧЕМУ???

Сообщение отредактировано: -=BR@BUS=- - 21.12.2006 19:45

[volvo]

Я тебе привел рабочую программу, которая давала правильный ответ... Ты ее исправлял? Тогда чего спрашиваешь? Разбирайся, ЧТО, ГДЕ и, главное, ЗАЧЕМ исправлял?

[-=BR@BUS=-]

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

[мисс_граффити]

не умеешь писать ввод матрицы?

[volvo]

      sum := 0; { обнуляем сумму для данной строки/столбца, и наше "псевдомножество" }
      for k := 1 to n do elems[k] := 0; { <--- Вот эту строку, например ... }

... я, по-твоему, для красоты напечатал? По какому праву ты ее убрал, и как хочешь, чтобы программа БЕЗ нее правильно работала?

[-=BR@BUS=-]

Как всегда => верно volvo