ENG  RUS Timus Online Judge
Online Judge
Problems
Authors
Online contests
Site news
Webboard
Problem set
Submit solution
Judge status
Guide
Register
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

## Discussion of Problem 1418. Military Story

Posted by Wrong Answers 2 Nov 2007 12:19
I'm a newbie, and I don't know why i'm wrong at test #3. Thanks in advanced.
const inp='';
out='';
var i,c,count,m,n:longint;
x1,y1,p,x,y:array[1..4005] of integer;
mark:array[1..4005] of 0..1;
f:text;

function lower(i,j:integer):boolean;
begin
{ lower:=false;
if (y[i]=y[1]) and (y[j]=y[1]) then if x[i]<x[j] then lower:=true
else if(x[i]=x[1]) and (x[j]=x[1]) then if y[i]>y[j] then lower:=true
else                                                   }
lower:=(y[i]-y[1])*(x[j]-x[1])<(x[i]-x[1])*(y[j]-y[1]);
end;

procedure swap(i,j:integer);
var t:integer;
begin
t:=x[i]; x[i]:=x[j]; x[j]:=t;
t:=y[i]; y[i]:=y[j]; y[j]:=t;
end;

{----------------------------------------------------------------------}
procedure Qsort(left,right:integer);
var l,r,m:integer;
begin
l:=left; r:=right; m:=(l+r) div 2;
while l<r do
begin
while lower(l,m) do inc(l);
while lower(m,r) do dec(r);
if (l<=r) then
begin
swap(l,r);
inc(l); dec(r);
end;
end;
if left<r then qsort(left,r);
if l<right then qsort(l,right);
end;
{----------------------------------------------------------------------}
procedure input;
var f:text;
i,j:integer;
begin
assign(f,inp); reset(f);
p[1]:=1;
for i:=2  to n do
begin
end;
end;
{----------------------------------------------------------------------}
function CCW(i,j,k:integer):integer;
var t,a1,b1,a2,b2:integer;
begin
a1:=x[j]-x[i]; b1:=y[j]-y[i];
a2:=x[k]-x[j]; b2:=y[k]-y[j];
t:=a1*b2-a2*b1;
if t=0 then ccw:=0 else if t>0 then ccw:=1 else ccw:=-1;
end;
{----------------------------------------------------------------------}
procedure find;
var t,i,j:integer;
begin
t:=1;
for i:=2 to n do
if y[i]<y[t] then t:=i else if y[i]=y[t] then if x[i]>x[t] then t:=i;
swap(1,t);
Qsort(2,n);
j:=2;
m:=2;p[1]:=1; p[2]:=2;
for i:=3 to n do
begin
while (ccw(p[m-1],p[m],i)<>1) and (m>1) do dec(M);
inc(m);
p[m]:=i;
end;
fillchar(mark,sizeof(mark),0);
mark[1]:=1;
for i:=1 to m do mark[p[i]]:=1;
end;

begin
input;
count:=0; c:=n;
repeat;
find; c:=0;
if (m<3) or (ccw(p[1],p[2],p[m])=0) then break;
inc(count);
for i:=1 to n do if mark[i]=0 then
begin
inc(c); x1[c]:=x[i]; y1[c]:=y[i];
end;
y:=y1; x:=x1; n:=c;
until c<3;
assign(f,out); rewrite(f);
writeln(f,count);
close(f);
end.