MILITARY - Câu chuyện người lính
Tác giả: RR
Ngôn ngữ: Pascal
//Wishing myself a happy lunar new year with a lot of accept solutions
//Written by Nguyen Thanh Trung
{$R+,Q+}
PROGRAM MILITARY;
CONST
fi='';
fo='';
maxn=4000;
esp=0.000001;
TYPE
rec=record x,y:real; ind:integer; end;
VAR
n,c,m,kq:integer;
a,b:array[1..maxn] of rec;
Procedure ReadInput;
Var
f:text;
i:integer;
Begin
Assign(f,fi); Reset(f);
Readln(f,n);
For i:=1 to n do
with a[i] do
begin
Readln(f,x,y);
ind:=i;
end;
Close(f);
End;
Procedure WriteOutput;
Var
f:text;
Begin
Assign(f,fo); Rewrite(f);
Writeln(f,kq);
Close(f);
End;
Procedure Swap(var p1,p2:rec);
Var
temp:rec;
Begin
temp:=p1; p1:=p2; p2:=temp;
End;
Function CCW(p1,p2,p3:rec):integer;
Var
t,a1,a2,b1,b2:real;
Begin
a1:=p2.x-p1.x;
b1:=p2.y-p1.y;
a2:=p3.x-p2.x;
b2:=p3.y-p2.y;
t:=a1*b2-a2*b1;
If abs(t)<esp then CCW:=0
else if t<0 then CCW:=-1
else CCW:=1;
End;
Function Lower(p1,p2:rec):boolean;
Var
t,a1,a2,b1,b2:real;
Begin
a1:=p1.x-a[1].x;
b1:=p1.y-a[1].y;
a2:=p2.x-a[1].x;
b2:=p2.y-a[1].y;
t:=a1*b2-a2*b1;
Lower:=false;
If (t>esp) then Lower:=true
else If (abs(t)<esp) and ((p1.x<p2.x) or ((p1.x=p2.x) and (p1.y<p2.y)))
then Lower:=true;
End;
Procedure Find;
Var
i:integer;
Begin
c:=1;
For i:=2 to n do
If (a[i].y<a[c].y) or ((a[i].y=a[c].y) and (a[i].x<a[c].x)) then
c:=i;
End;
Procedure QuickSort;
Procedure Sort(l,r:integer);
Var
i,j:integer;
x:rec;
Begin
i:=l; j:=r; x:=a[(l+r) div 2];
repeat
while lower(a[i],x) do inc(i);
while lower(x,a[j]) do dec(j);
if i<=j then
begin
Swap(a[i],a[j]);
inc(i); dec(j);
end;
until i>j;
if i<r then Sort(i,r);
if l<j then Sort(l,j);
End;
Begin
If n>2 then Sort(2,n);
End;
Procedure Graham;
Var
i:integer;
Begin
m:=2; b[1]:=a[1]; b[2]:=a[2];
b[1].ind:=1; b[2].ind:=2;
For i:=3 to n do
begin
while (m>1) and (CCW(b[m-1],b[m],a[i])=-1) do dec(m);
inc(m);
b[m]:=a[i];
b[m].ind:=i;
end;
End;
Procedure Kt;
Var
i:integer;
mm:integer;
Begin
mm:=m; m:=2;
For i:=3 to mm do
begin
while (m>1) and (CCW(b[m-1],b[m],b[i])<>1) do dec(m);
inc(m);
b[m]:=b[i];
end;
End;
Procedure LoaiDiem;
Var
i,j:integer;
n1:integer;
Begin
For i:=1 to m do
a[b[i].ind].ind:=-1;
i:=1; j:=1; n1:=0;
repeat
while a[j].ind=-1 do inc(j);
if j<n then
begin
a[i]:=a[j];
inc(n1);
inc(i); inc(j);
end;
until j>=n;
n:=n1;
End;
Procedure Solve;
Begin
kq:=0;
repeat
Find;
Swap(a[c],a[1]);
QuickSort;
Graham;
LoaiDiem;
Kt;
If m>2 then inc(kq)
else exit;
until m<=2;
End;
BEGIN
ReadInput;
Solve;
WriteOutput;
END.