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

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

Why it does not work?
Послано Ovchinnikov Georg 17 апр 2003 22:46
program permutation;

function evklid(a,b:longint):longint;
Begin
while (a>0) and (b>0) do
 if a>b then a:= a mod b else b:= b mod a;
 evklid := a;
 if a = 0 then evklid:=b;
end;

var
M,prm : array [1..1000] of longint;
i,n,j,k : longint;
Begin
readln(N);
for i := 1 to N do
 read(prm[i]);
for i := 1 to N do begin
  j:=prm[i];
  m[i]:=1;
 while i<>j  do begin
  j:=prm[j];
  m[i]:=m[i]+1;
 end;
end;
m[n+1]:=1;
for i := 1 to N do begin
 m[i]:=m[i]*m[i+1] div evklid(m[i],m[i+1]);
 m[i+1]:=m[i];
end;
writeln(m[n+1])
end.