Cod sursa(job #680731)

Utilizator MihaiBunBunget Mihai MihaiBun Data 15 februarie 2012 21:07:43
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.62 kb
program kk;
var f:text;
    i,n,p,q,nr:longint;
    x,y:array[1..120000] of extended;
    a:array[1..120000] of longint;
    min,t:extended;

procedure sort(l,r:longint);
var i1,j1,m:longint;
begin
  i1:=l;j1:=r;m:=(l+r)div 2;
  repeat
    while (y[i1]-y[1])*(x[m]-x[1])<(y[m]-y[1])*(x[i1]-x[1]) do i1:=i1+1;
    while (y[m]-y[1])*(x[j1]-x[1])<(y[j1]-y[1])*(x[m]-x[1]) do j1:=j1-1;
    if i1<=j1 then begin
                    t:=x[i1];
                    x[i1]:=x[j1];
                    x[j1]:=t;
                    t:=y[i1];
                    y[i1]:=y[j1];
                    y[j1]:=t;
                    i1:=i1+1;
                    j1:=j1-1;
                   end;
  until i1>j1;
  if l<j1 then sort(l,j1);
  if i1<r then sort(i1,r);
end;

procedure stiva;
begin
  a[1]:=1;
  a[2]:=2;
  nr:=2;
  for i:=3 to n+1 do
    begin
      while ((x[a[nr]]-x[a[nr-1]])*(y[i]-y[a[nr-1]])<(x[i]-x[a[nr-1]])*(y[a[nr]]-y[a[nr-1]]))
                    and(nr>2) do nr:=nr-1;
      nr:=nr+1;
      a[nr]:=i;
    end;
end;

begin
  assign(f,'infasuratoare.in');
  reset(f);
  min:=2000000000;
  readln(f,n);
  for i:=1 to n do
    begin
      readln(f,x[i],y[i]);
      if x[i]<min then begin min:=x[i];p:=i;end
                  else if x[i]=min then
                           if y[i]<y[p] then p:=i;

    end;
  x[n+1]:=x[1];
  y[n+1]:=y[1];
  t:=x[1];
  x[1]:=x[p];
  x[p]:=t;
  t:=y[1];
  y[1]:=y[p];
  y[p]:=t;
  sort(2,n);
  stiva;
  close(f);
  assign(f,'infasuratoare.out');
  rewrite(f);
  writeln(f,nr-1);
  for i:=1 to nr-1 do writeln(f,x[a[i]],' ',y[a[i]]);
  close(f);
end.