WA 2 give me some tests please!
Posted by
TEST 1 Jun 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.