Используя генератор случайных чисел, сформировать массив размерностью NxN (размерность тоже формируется с помощью генератора случайных чисел) таким образом, чтобы все элементы строки были различны и принимали значения от 1 до N. После формирования массива проверить, является ли массив латинским квадратом.

Латинский квадрат — это квадратная матрица, в которой каждая строка и каждый столбец содержат все числа от 1 до N. Считать, что N<=20. Если полученный массив латинским квадратом не является, повторить процесс его формирования заново и так до тех пор, пока не будет получен искомый результат.

type
  MyArr=array [1..20,1..20] of integer;
var
  a:MyArr;
  i,j,k,n:integer;
  fl:boolean;
{функция факториала}
function Fact(n:integer):real;
var
  i,res:integer;
begin
  res:=1;
  for i:=1 to n do
    res:=res*i;
  Fact:=res
end;
{функция проверки на латинский квадрат}
function Lat(a:MyArr;n:integer):boolean;
var
  i,j,str,col:integer;
  temp:real;
  fl:boolean;
begin
  fl:=true;
  temp:=Fact(n);
  i:=1;
  while fl and (i<=n) do
  begin
    str:=1;
    col:=1;
    for j:=1 to n do
    begin
      str:=str*a[i,j];
      col:=col*a[j,i];
    end;
    if (str<>temp)or(col<>temp) then
      fl:=false;
    inc(i)
  end;
  Lat:=fl
end;
{основная программа}
begin
  n:=5;{тут можешь заменить если нужно случайное на n:=random(20)+1;}
  writeln('Размер матрицы ',n,'x',n);
  repeat
    {задаем матрицу}
    for i:=1 to n do
      for j:=1 to n do
        repeat
          a[i,j]:=random(n)+1;
          fl:=true;
          for k:=1 to j do
            if (a[i,k]=a[i,j]) and (k<>j) then
              fl:=false;
        until
          fl;
  until
    Lat(a,n);
  {выводим матрицу}
  for i:=1 to n do
  begin
    for j:=1 to n do
      write(a[i,j]:2,' ');
    writeln
  end
end.

Вариант 2

uses crt;
const max=20;
type mas=array[1..max] of byte;//строка матрицы
     matr=array[1..max] of mas;//матрица-массив строк
procedure Stroka(var v:mas;n:byte);//заполняем строку числами
var m:set of byte;
    i,c:byte;
begin
m:=[];
for i:=1 to n do
 begin
  repeat
   c:=random(n)+1;//читаем число
  until not(c in m);//если его нет в множестве
  include(m,c);//заносим
  v[i]:=c;//и в строку
 end;
end;
procedure Matrica(var mt:matr;n:byte);//создание матрицы
var i:byte;
begin
for i:=1 to n do
Stroka(mt[i],n);//создаем все строки
end;
function Prov(mt:matr;n:byte):boolean;//проверка на лат. квадрат
var i,j,k,p:byte;
    m:set of byte;
begin
k:=0;
for i:=1 to n do//проверяем строки
 begin
  p:=0;
  m:=[];
  for j:=1 to n do
  if not(mt[i,j] in m) then
    begin
     p:=p+1;
     include(m,mt[i,j]);
    end;
  if p=n then k:=k+1;//если все числа разные, считаем строку
 end;
for j:=1 to n do//то же по столбцам
 begin
  p:=0;
  m:=[];
  for i:=1 to n do
  if not(mt[i,j] in m) then
    begin
     p:=p+1;
     include(m,mt[i,j]);
    end;
  if p=n then k:=k+1;
 end;
if k=2*n then Prov:=true//если все строки и столбцы, то да
else Prov:=false;
end;
 
var a:matr;
    n,i,j:byte;
begin
clrscr;
randomize;
{n:=random(max)+1;}
n:=5;
repeat
Matrica(a,n);
until Prov(a,n);
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:4);
  writeln;
 end;
readln
end.

Leave a Comment

− 4 = 5