Cod sursa(job #724521)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 26 martie 2012 17:03:47
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.85 kb
program pascal;
type pct=record
     x,y:real;
     end;
var p:array[1..120000] of pct;
    n,k,m,pas,i:longint;
    s:array[1..120000] of longint;
    x:real;

    procedure pivot(s,d:longint);
    var pi,pj,i,j,a:longint;
        aux:pct;
    begin
     i:=s; j:=d; pi:=0; pj:=1;
     while i<j do
       begin
         if (p[i].y>p[j].y)or((p[i].y=p[j].y)and(p[i].x>p[j].x)) then
             begin
               aux:=p[i]; p[i]:=p[j]; p[j]:=aux;
               a:=pi; pi:=pj; pj:=a;
            end;
         i:=i+pi; j:=j-pj;
       end;
     m:=i;
   end;

procedure qsort(s,d:longint);
  begin
    if s<d then
      begin
        pivot(s,d);
        qsort(s,m-1); qsort(m+1,d);
      end;
  end;

function semn(a,b,c:pct):integer;
   begin
     if (a.y-b.y)*c.x+(b.x-a.x)*c.y+a.x*b.y-a.y*b.x<=0 then semn:=-1
                                                       else semn:=1;
   end;
procedure modifica;
   begin
     if pas=1 then
       begin
         inc(i);
         if i=n then pas:=-1;
       end
         else dec(i);
   end;

procedure convex;
  var v:array[1..120000] of boolean;
  begin
    fillchar(v,sizeof(v),false);
    pas:=1;
    s[1]:=1; s[2]:=2; v[2]:=true;
    k:=2; i:=2;
    while i>1 do
      begin
        while v[i] do modifica;
        if i=0 then break;
        while (k>1) and ( semn( p[s[k-1]] , p[s[k]], p[i])<0) do
           begin
             v[s[k]]:=false;
             dec(k);
           end;
        inc(k);
        s[k]:=i;
        v[i]:=true;
      end;
  end;
begin
assign(input,'infasuratoare.in'); reset(input);
assign(output,'infasuratoare.out'); rewrite(output);
read(n);
for k:=1 to n do read(p[k].x,p[k].y);
qsort(1,n);
convex;
if s[1]=s[k] then dec(k);
writeln(k);
for i:=1 to k do writeln(p[s[i]].x:16:6,' ',p[s[i]].y:16:6);
close(input);
close(output);
end.