ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1418. Military Story

Please help me with this code
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);
 readln(f,n);
 readln(f,x[1],y[1]);
 p[1]:=1;
 for i:=2  to n do
  begin
     readln(f,x[i],y[i]);
  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.