Cod sursa(job #1096190)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 1 februarie 2014 17:45:04
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.54 kb
program infas;
type punct=record
    x,y:real;
    end;
var a:array[1..120000] of punct;
   p:array[1..120000] of real;
    st:array[1..120000] of punct;
    b1,b2:array[1..1 shl 16] of char;
    n,i,j,k,o:longint;
    aux:punct;
procedure sort(l,r:longint);
var i,j,m:longint;
   aux:real;
     aux1:punct;
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;
               aux1:=a[i]; a[i]:=a[j]; a[j]:=aux1;
               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:=a[i].x*a[j].y+a[j].x*a[k].y+a[k].x*a[i].y-a[i].y*a[j].x-a[j].x*a[k].x-a[k].y*a[i].x;
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(a[i].x,a[i].y);
                if (a[i].x<a[o].x) or ((a[i].x=a[o].x) and (a[i].y<a[o].y))then o:=i;
                end;
aux:=a[1]; a[1]:=a[o]; a[o]:=aux;
for i:=2 to n do
    if a[i].x=a[1].x then p[i]:=1 shl 30 else
    p[i]:=(a[i].y-a[1].x)/(a[i].x-a[1].x);
sort(2,n);
st[1]:=a[1];
st[2]:=a[2];
k:=2;
for i:=3 to n do
  begin
  while (k>=1) and (CP(k-1,k,i)<0) do dec(k);
  inc(k);
 st[k]:=a[i];
  end;
writeln(k);
for i:=1 to k do writeln(st[i].x:0:6,' ',st[i].y:0:6);
close(output);
end.