Cod sursa(job #1096157)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 1 februarie 2014 16:51:07
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.55 kb
program infas;
var x,y,p:array[1..120000] of real;
    st:array[1..120000] of longint;
    b1,b2:array[1..1 shl 16] of char;
    n,i,j,k,o:longint;
    aux:real;
procedure sort(l,r:longint);
var i,j,m:longint;
   aux:real;
begin
i:=l;
j:=r;
m:=(i+j) div 2;
repeat
  while (p[i]<p[m]) do inc(i);
  while (p[j]>p[m]) do dec(j);
  if (i<=j) then  begin
               aux:=p[i]; p[i]:=p[j]; p[j]:=aux;
               aux:=x[i]; x[i]:=x[j]; x[j]:=aux;
               aux:=y[i]; y[i]:=y[j]; y[j]:=aux;
               inc(i); dec(j);
               end;
  until (i>j);
  if (i<r)  then sort(i,r);
  if (l<j)  then sort(l,j);
end;
function Cp(i,j,k:longint):real;
begin
  CP:=x[i]*y[j]+x[j]*y[k]+x[k]*y[i]-y[i]*x[j]-y[j]*x[k]-y[k]*x[i];
end;
begin
assign(input,'infasuratoare.in'); reset(input);settextbuf(input,b1);
assign(output,'infasuratoare.out'); rewrite(output);settextbuf(output,b2);
readln(n);  o:=1;
for i:=1 to n do begin
                readln(x[i],y[i]);
                if (x[i]<x[o]) or ((x[i]=x[o]) and (y[i]<y[o]))then o:=i;
                end;
aux:=x[1]; x[1]:=x[o]; x[o]:=aux;
aux:=y[1]; y[1]:=y[o]; y[o]:=aux;
for i:=2 to n do
    if x[i]=x[1] then p[i]:=1 shl 30 else
    p[i]:=(y[i]-y[1])/(x[i]-x[1]);
sort(2,n);
for i:=1 to n do writeln(x[i]:0:2,' ',y[i]:0:2);
writeln;
writeln;
st[1]:=1;
st[2]:=2;
k:=2;
for i:=3 to n do
  begin
  while (k>=1) and (CP(st[k-1],st[k],i)<0) do dec(k);
  inc(k);
  st[k]:=i;
  end;
writeln(k);
for i:=1 to k do writeln(x[st[i]]:0:6,' ',y[st[i]]:0:6);
close(output);
end.