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

Обсуждение задачи 1444. Накормить элефпотама

WA 2 give me some tests please!
Послано TEST 1 июн 2009 19:42
program p1444;
uses math;
const
  maxn=30000;
var
  s:array[1..maxn] of record
                        x,y:longint;
                      end;
  num:array[1..maxn] of longint;
  t,len:array[1..maxn] of double;
  n,m,i,j,k:longint;

procedure readdata;
var
  i,j,k:longint;
begin
  readln(n);
  for i:=1 to n do
    readln(s[i].x,s[i].y);
end;

procedure swap(var a,b:longint); inline;
var temp:longint;
begin
  temp:=a; a:=b; b:=temp;
end;

procedure sp(var a,b:double); inline;
var temp:double;
begin
  temp:=a; a:=b; b:=temp;
end;

procedure qsort(s,b:longint);
var
  i,j:longint;
  tx,lenx:double;
begin
  if s>=b then exit;
  i:=s; j:=b;
  tx:=t[(i+j) shr 1]; lenx:=len[(i+j) shr 1];
  repeat
    while (t[j]>tx)or( (t[j]=tx)and(len[j]>lenx) ) do dec(j);
    while (t[i]<tx)or( (t[i]=tx)and(len[i]<lenx) ) do inc(i);
    if i<=j then
      begin
        swap(num[i],num[j]);
        sp(t[i],t[j]);
        sp(len[i],len[j]);
        inc(i); dec(j);
      end;
  until i>=j;
  qsort(s,j); qsort(i,b);
end;

procedure qsort2(s,b:longint);
var
  i,j:longint;
  tx,lenx:double;
begin
  if s>=b then exit;
  i:=s; j:=b;
  tx:=t[(i+j) shr 1]; lenx:=len[(i+j) shr 1];
  repeat
    while (t[j]<tx)or( (t[j]=tx)and(len[j]>lenx) ) do dec(j);
    while (t[i]>tx)or( (t[i]=tx)and(len[i]<lenx) ) do inc(i);
    if i<=j then
      begin
        swap(num[i],num[j]);
        sp(t[i],t[j]);
        sp(len[i],len[j]);
        inc(i); dec(j);
      end;
  until i>=j;
  qsort2(s,j); qsort2(i,b);
end;

procedure solve;
var
  check:boolean;
  i,j,k:longint;
begin
  for i:=2 to n do
    begin
      dec(s[i].x,s[1].x);
      dec(s[i].y,s[1].y);
    end;
  s[1].x:=0; s[1].y:=0;
  for i:=2 to n do
    len[i]:=sqrt(sqr(s[i].x)+sqr(s[i].y));
  for i:=2 to n do
    begin
      t[i]:=arccos(s[i].x/len[i]);
      if s[i].y<0 then t[i]:=2*pi-t[i];
    end;
  for i:=1 to n do
    num[i]:=i;
  check:=false;
  for i:=2 to n do
    if (abs(t[i]-pi)>1e-8)and(t[i]<pi)and(0<t[i]) then check:=true;
  if check then
    qsort(2,n) else
    begin
      for i:=1 to n do
        if (s[i].x>0)and(t[i]=0) then t[i]:=2*pi;
      qsort2(2,n);
    end;
  writeln(n);
  for i:=1 to n do
    writeln(num[i]);
end;

begin
  readdata;
  solve;
end.
Re: WA 2 give me some tests please!
Послано Timur Sitdikov (MSU TB) 22 май 2011 09:54
This test helped me:
4
0 0
1 -1
2 0
1 1

answer may be
4
1
2
3
4

or
4
1
4
3
2