ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1024. Перестановки

var
   p,a,b:array[1..1000] of 1..1000;
   n,i:1..1000; l:0..1;
   k:longint;
begin
  readln(n); k:=1;
  for i:=1 to n do
   begin
     read(p[i]);
     a[i]:=p[i];
   end;
  repeat
  l:=0;
  for i:=1 to n do
   begin
     b[i]:=a[p[i]];
     if b[i]<>i then l:=1;
   end;
  k:=k+1;
  if l<>1 then begin write(k); halt; end;
  l:=0;
  for i:=1 to n do
   begin
     a[i]:=b[p[i]];
     if a[i]<>i then l:=1;
   end;
  k:=k+1;
  if l<>1 then begin write(k); halt; end;
  until false;
end.

Edited by author 31.08.2006 21:02