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

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

Why I got WA?
Послано Jack(China) 16 июл 2003 12:51
var num,c,temp:array [1..1000] of longint;
    i,s,n:longint;

procedure run_2(a,b:longint);
var d:longint;
begin
  s:=a*b;
  if b>a then
    begin d:=a; a:=b; b:=d; end;
  while a mod b<>0 do
   begin
     d:=a mod b;
     a:=b;
     b:=d;
   end;
  s:=s div b;
end;

procedure run_1(k:longint);
var i:longint;
begin
  temp[1]:=num[k];
  i:=1;
  while temp[i]<>k do
   begin
     i:=i+1;
     temp[i]:=num[temp[i-1]];
   end;
  c[k]:=i;
end;

begin
  read(n);
  for i:=1 to n do read(num[i]);
  for i:=1 to n do run_1(i);
  s:=c[1]; for i:=2 to n do run_2(s,c[i]);
  writeln(s);
end.