ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1418. Армейская история

Please help me with this code
Послано Wrong Answers 2 ноя 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.