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

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

WA!!!
Послано Inzaghi 19 сен 2003 19:29
var i,j,k,n,m,l:longint;
    a:array[1..10000]of longint;
    p:boolean;
begin
     readln(n);
     for i:=1 to n do
     begin
          read(k);
          if k>i then k:=k-i
                 else k:=i-k;
          if k=0 then continue;
          p:=false;l:=k;
          for j:=2 to trunc(sqrt(l)) do
          begin
               m:=0;
               repeat
                     if k mod j=0 then begin inc(m);k:=k div
j;p:=true;end
                                  else break;
                     if k=0 then break;
               until false;
               if m>a[j] then a[j]:=m;
          end;
          if (p=false)and(a[k]=0) then a[k]:=1;
     end;
     k:=1;
     for i:=2 to 1000 do if a[i]>0 then
         for j:=1 to a[i] do k:=k*i;
     writeln(k);
end.