for problem 1103(+)
JUDGE BUG:
begin
Halt;
end.
This code get AC!!!
My program(Accepted)(I don't think that it's correct):
{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+}
Program t1103;
Const MaxN = 5000;
Eps = 1E-15;
Var C : array[1..MaxN]of record X,Y : extended end;
O : array[1..MaxN-2]of extended;
Pos : array[1..MaxN-2]of integer;
a,b,R : extended;
N,i,j : longint;
MinI,kI : longint;
W : extended;
np : boolean;
Procedure Swap(Var A1,A2 : integer);
Var t : integer;
begin
t:=A1;
A1:=A2;
A2:=t;
end;
Procedure Merge(left,middle,rigth : integer);
Var Ileft,Irigth,Cur,i : integer;
Tmp : array[0..MaxN+1]of integer;
begin
Ileft:=left;
Irigth:=middle+1;
Cur:=0;
While True do begin
Cur:=Cur+1;
if O[Pos[Ileft]]<O[Pos[Irigth]] then begin
Tmp[Cur]:=Pos[Ileft];
Ileft:=Ileft+1;
end else begin
Tmp[Cur]:=Pos[Irigth];
Irigth:=Irigth+1;
end;
if Ileft=middle+1 then begin
for i:=Irigth to rigth do begin
Cur:=Cur+1;
Tmp[Cur]:=Pos[i];
end;
break;
end;
if Irigth=rigth+1 then begin
for i:=Ileft to middle do begin
Cur:=Cur+1;
Tmp[Cur]:=Pos[i];
end;
break;
end;
end;
for i:=1 to rigth-left+1 do
Pos[left+i-1]:=Tmp[i];
end;
Procedure MergeSort(left,rigth : integer);
Var middle : integer;
begin
if rigth-left<=0 then exit;
if rigth-left=1 then begin
if O[Pos[left]]-O[Pos[rigth]]>Eps then
Swap(Pos[left],Pos[rigth]);
exit;
end;
middle:=(left + rigth) div 2;
MergeSort(left,middle);
MergeSort(middle+1,rigth);
Merge(left,middle,rigth);
end;
Procedure Solve(x1,y1,x2,y2,x3,y3 : extended);
Var t1,t2,t3,u1,u2,u3 : extended;
begin
t1:=2*(x1-x2);
u1:=2*(x3-x2);
t2:=2*(y1-y2);
u2:=2*(y3-y2);
t3:=x2*x2+y2*y2-x1*x1-y1*y1;
u3:=x2*x2+y2*y2-x3*x3-y3*y3;
if abs(t1)>Eps then begin
if abs(u2-(u1*t2)/t1)<eps then begin np:=true; exit; end;
b:=-(u3-(t3*u1)/t1)/(u2-(u1*t2)/t1);
a:=-b*(t2/t1)-(t3/t1);
end else begin
b:=-t3/t2;
a:=-(b*u2+u3)/u1;
end;
R:=sqrt(sqr(x1-a)+sqr(y1-b));
end;
Function GetDist(x1,y1,x2,y2 : extended) : extended;
begin
GetDist:=Sqrt(Sqr(x1-x2)+Sqr(y1-y2));
end;
Function Check(a1,a2,a3 : integer) : boolean;
Var i,ls,gr,j : integer;
d : extended;
begin
np:=false;
Solve(C[a1].X,C[a1].Y,C[a2].X,C[a2].Y,C[a3].X,C[a3].Y);
if np then begin Check:=false; exit; end;
ls:=0;
gr:=0;
j:=0;
for i:=1 to N do if (i<>a1)and(i<>a2)and(i<>a3) then begin
d:=GetDist(a,b,C[i].X,C[i].Y);
if d<R then ls:=ls+1 else gr:=gr+1;
j:=j+1;
end;
if ls+gr<>n-3 then begin
r:=0;
d:=d/r;
end;
Check:=(ls=gr);
end;
begin
Read(N);
for i:=1 to N do Read(C[i].X,C[i].Y);
MinI:=1;
for i:=2 to N do
if (C[i].Y<C[MinI].Y)or((C[i].Y=C[MinI].Y)and(C[i].X<C[MinI].X))
then
MinI:=i;
W:=-1;
for i:=1 to N do
if i<>MinI then begin
if C[i].Y=C[MinI].Y then begin kI:=i; break; end;
if abs(C[i].X-C[MinI].X)/(C[i].Y-C[MinI].Y)>W then begin
W:=abs(C[i].X-C[MinI].X)/(C[i].Y-C[MinI].Y);
kI:=i;
end;
end;
a:=C[MinI].X;
b:=C[MinI].Y;
j:=0;
for i:=1 to N do
if i<>MinI then
if i<>kI then begin
j:=j+1;
Pos[j]:=j;
O[j]:=GetDist(a,b,C[i].X,C[i].Y);
end;
MergeSort(1,N-2);
for i:=((N-2) div 2)+1 downto 1 do begin
j:=i;
if Check(MinI,kI,Pos[j]) then begin
Writeln(C[MinI].X:0:0,' ',C[MinI].Y:0:0);
Writeln(C[kI].X:0:0,' ',C[kI].Y:0:0);
Writeln(C[Pos[j]].X:0:0,' ',C[Pos[j]].Y:0:0);
Halt(0);
end;
j:=N-2-i+1;
if Check(MinI,kI,Pos[j]) then begin
W