Cod sursa(job #365059)

Utilizator philipPhilip philip Data 17 noiembrie 2009 19:48:55
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.79 kb
const nmax=120000;

type list=array[0..nmax] of longint;

var i,n,k:longint;
    x,y:array[0..nmax] of real;
    ind,st:list;

procedure qsort(var a:list);

    procedure sort(l,r: longint);
      var
         i,j,m,t:longint;
      begin
         i:=l;
         j:=r;
         m:=(l+r) div 2;
         repeat
           while (y[ind[i]]-y[k])*(x[ind[m]]-x[k])<(y[ind[m]]-y[k])*(x[ind[i]]-x[k]) do
            inc(i);
           while (y[ind[m]]-y[k])*(x[ind[j]]-x[k])<(y[ind[j]]-y[k])*(x[ind[m]]-x[k]) do
            dec(j);
           if not(i>j) then
             begin
                t:=ind[i];
                ind[i]:=ind[j];
                ind[j]:=t;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;

    begin
       sort(1,ind[0]);
    end;

function semn(v1,v2,v3:longint):real;
  begin
    semn:=x[v1]*y[v2]+x[v2]*y[v3]+x[v3]*y[v1]-x[v3]*y[v2]-x[v2]*y[v1]-x[v1]*y[v3];
  end;

begin
  assign(input,'infasuratoare.in');
  assign(output,'infasuratoare.out');
  reset(input);
  rewrite(output);
  readln(n);

  k:=1;
  for i:=1 to n do begin
        readln(x[i],y[i]);
        if (x[i]<x[k]) or ((x[i]=x[k]) and (y[i]<y[k])) then
                k:=i;

  end;

  for i:=1 to n do
        if i<>k then begin
                inc(ind[0]);
                ind[ind[0]]:=i;
        end;

  qsort(ind);


  st[1]:=k;
  st[0]:=1;
  for i:=1 to ind[0] do begin
    while (st[0]>2) and (semn(st[st[0]-1],st[st[0]],ind[i])<0) do
        dec(st[0]);
    inc(st[0]);
    st[st[0]]:=ind[i];
  end;

  writeln(st[0]-1);
  for i:=1 to st[0] do writeln(x[st[i]]:16:6,' ',y[st[i]]:16:6);

  close(input);
  close(output);
end.