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

Обсуждение задачи 1252. Сортировка надгробий

WHY WHONG ANSWER ???????
Послано vano_B1 10 июл 2003 21:53
type
  maxm=1..130001;
var
 m,p:array [1..130001] of maxm;
 n,i1,j1,l,k:longint;

function nod(a,b:maxm):maxm;
begin
while (a<>0) and (b<>0) do
    if a>b then a:=a mod b else b:=b mod a;
if a=0 then nod:=b else nod:=a;
end;

procedure swapl(var a,b:maxm);
var
d:maxm;
begin
d:=a;
a:=b;
b:=d;
end;

procedure sort(l,r:maxm);
var
 i,j,x:maxm;
begin
i:=l;
j:=r;
x:=m[(r+l) div 2];
repeat
while m[i]<x do inc(i);
while m[j]>x do dec(j);
if i<=j then begin
swapl(m[i],m[j]);
swapl(p[i],p[j]);
inc(i);
dec(j);
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;

begin
readln(n);
for i1:=1 to n do readln(m[i1]);
for i1:=1 to n do p[i1]:=i1;
sort(1,n);


l:=1;
while (p[l]-l=0) and (l<>n+1) do inc(l);

if l=n+1 then begin
write(n-1);
halt;
end;
k:=abs(p[l]-l);


for i1:=l+1 to n do begin
if p[i1]-i1=0 then continue;
k:=nod(k,abs(p[i1]-i1));
end;
write(k-1);
end.