Cod sursa(job #400465)

Utilizator andrei31Andrei Datcu andrei31 Data 21 februarie 2010 14:20:11
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.28 kb
type punct=record
           x,y,p,d:real;
           end;
var n,nst:longint;
    a:array[1..120000] of punct;
    st:array[1..120000] of longint;
procedure swap(i,j:longint);
var aux:punct;
begin
aux:=a[i];
a[i]:=a[j];
a[j]:=aux;
end;

procedure citire;
var aux:punct;
    p0,i:longint;
begin
assign(input,'infasuratoare.in');reset(input);
readln(n);
readln(a[1].x,a[1].y);p0:=1;
for i:=2 to n do
 begin
 readln(a[i].x,a[i].y);
 if a[i].x<a[p0].x then p0:=i
    else if (a[i].x=a[p0].x) and (a[i].y<a[p0].y) then p0:=i;
 end;

if p0<>1 then
  swap(1,p0); a[1].p:=-1000000;
for i:=2 to n do
  begin
  if a[i].x<>a[1].x then
      a[i].p:=(a[i].y-a[1].y)/(a[i].x-a[1].x)
      else a[i].p:=1000000;
  a[i].d:=sqrt(sqr(a[i].y-a[1].y)+sqr(a[i].x-a[1].x));
 end;
end;




procedure comb(i,n:longint);
var go:longint;
begin
go:=i;
if (2*i<=n) then
            if a[2*i].p>a[i].p then go:=2*i
              else if (a[2*i].p=a[i].p) and (a[2*i].d>a[i].d) then go:=2*i;
if (2*i+1<=n) then
          if a[2*i+1].p>a[go].p then go:=2*i+1
              else if (a[2*i+1].p=a[go].p) and (a[2*i+1].d>a[go].d) then go:=2*i+1;
if go<>i then
   begin
   swap(go,i);
   comb(go,n);
   end;
end;

procedure formheap;
 var i:longint;
begin
for i:=n div 2 downto 1 do
comb(i,n)
end;

procedure heapsort;
var i:longint;
begin
for i:=n downto 2 do
 begin
 swap(1,i);
 comb(1,i-1);
 end;
end;

procedure baga(i:longint);
begin
inc(nst);
st[nst]:=i;
end;

procedure scoate;
begin
dec(nst);
end;

function det(p1,p2,p3:punct):real;
begin
det:=p1.x*p2.y+p1.y*p3.x+p2.x*p3.y-p3.x*p2.y-p3.y*p1.x-p2.x*p1.y;
end;

procedure rezolva;
var i:longint;
begin
baga(1);baga(2);
              i:=3;
while i<=n do
 begin
 if det(a[st[nst-1]],a[st[nst]],a[i])<=0 then
                                                scoate else begin
                                                                baga(i);
                                                                inc(i);
                                                                end;
 end;

assign(output,'infasuratoare.out');rewrite(output);
writeln(nst);

 for i:=1 to nst do
 writeln(a[st[i]].x:2:6,' ',a[st[i]].y:2:6);
close(output);
end;

begin
citire;
formheap;
heapsort;
rezolva;
end.