Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.01.2018, 22:14   #1
Aлена
 
Регистрация: 25.12.2017
Сообщений: 9
По умолчанию Паскаль , латинский квадрат

Как возможно упростить этот код ? ((
Uses Crt;
type
Sq = array [1..50, 1..50] of integer;

var
A: Sq;
n, i, j, R1, R2: integer;

procedure Testing(X: Sq; m, l, k: integer; var S: integer);
label Result;
var
i, j, l1, k1, p: integer;
begin
k1 := l;
l1 := k;
i := 1;
j := 1;
repeat
for p := 1 to m do
begin
if l = 1 then i := 1;
if k = 1 then j := 1;
S := 0;
repeat
if X[i, j] = p then S := 1;
i := i + l;
j := j + k;
until (i = m + 1) or (j = m + 1);
if S = 0 then goto Result;
end;
i := i + l1;
j := j + k1;
until (i = m + 1) or (j = m + 1);
S := 1;
Result:
end;

begin
clrscr;
Writeln('введите порядок квадрата (не больше 50)');
Readln(n);
for i := 1 to n do
begin
Writeln('введите по очереди элементы строки N ', i);
for j := 1 to n do Readln(A[i, j]);
end;
clrscr;
for i := 1 to n do
begin
for j := 1 to n do
Write('|', A[i, j]:7);
Writeln('|');
end;
Testing(A, n, 0, 1, R1);
Testing(A, n, 1, 0, R2);
if (R1 = 1) and (R2 = 1) then Writeln('Матрица - латинский квадрат')
Else Writeln('Матрица не является латинским квадратом');
Readln;
end.
Aлена вне форума Ответить с цитированием
Старый 21.01.2018, 11:32   #2
newerow1989
Я самый любопытный
Участник клуба
 
Аватар для newerow1989
 
Регистрация: 24.07.2012
Сообщений: 1,949
По умолчанию

Код:
const n=3;
type tAr=array[1..n,1..n] of integer;

function Testing(p:tAr):boolean;
var i,j:integer;
    b:array[1..n] of boolean;

   function ttt:boolean;
   var i:integer;
   begin
      Result:=true;
      For i:=1 to n-1 do
         If b[i]<>b[i+1] then
         begin
            Result:=false;
            Exit;
         end;
   end;

begin
   Result:=true;
   For i:=1 to n do
      b[i]:=false;
   For i:=1 to n do
   begin
      For j:=1 to n do
         b[p[i,j]]:=not b[p[i,j]];
      If not ttt then
      begin
         Result:=false;
         Exit;
      end;
   end;
   For j:=1 to n do
   begin
      For i:=1 to n do
         b[p[i,j]]:=not b[p[i,j]];
      If not ttt then
      begin
         Result:=false;
         Exit;
      end;
   end;
end;

var p:tAr;
    i,j,t:integer;
begin
   For i:=1 to n do
      For j:=1 to n do
      Repeat
         Write('p[',i,', ',j,'] = ');
         Readln(t);
         p[i,j]:=t;
         If (t<1) or (t>n) then
            Writeln('Diapazon [1 .. ',n,'] !!!') else
            Break;
      Until false;
   Writeln;
   For i:=1 to n do
   begin
      For j:=1 to n do
         Write(p[i,j]:3,'  ');
      Writeln;
   end;
   Writeln;
   If Testing(p) then
      Writeln('yes') else
      Writeln('no');
   Readln;
end.
С запрограммированным приветом, Неверов Евгений!
Сайт: http://newerow1989.ru
[Паскаль] [Delphi]
newerow1989 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Латинский квадрат KOMPNET Помощь студентам 2 27.11.2011 15:20
ПОСТРОИТЬ ЛАТИНСКИЙ КВАДРАТ НА С++ innaa639 Помощь студентам 4 23.11.2009 17:31
Латинский квадрат innaa639 Помощь студентам 1 22.11.2009 22:40
"Латинский" квадрат. Паскаль SmartStas Помощь студентам 9 19.03.2009 16:37