Cod sursa(job #387174)

Utilizator costyv87Vlad Costin costyv87 Data 26 ianuarie 2010 22:43:48
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.22 kb
type punct=record
        x,y:real;
        end;
     vector=array[1..130000] of punct;
var f,g:text;
     st,v:vector;
     aux:punct;
     maxx,maxy,max:real;
     ii,nn,maxc,i,n,j:longint;
procedure QuickSort(var v:vector; Lo, Hi: longint);

procedure Sort(l, r: longint);
var
  i, j  : longint;     x,y:punct;
begin
  i := l; j := r; x := v[(l+r) DIV 2];
  repeat
    while (v[1].y-v[i].y)*(v[1].x-x.x)<(v[1].y-x.y)*(v[1].x-v[i].x) do i := i + 1;
    while (v[1].y-x.y)*(v[1].x-v[j].x)<(v[1].y-v[j].y)*(v[1].x-x.x) do j := j - 1;
    if i <= j then
    begin
      y := v[i]; v[i] := v[j]; v[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;

begin {QuickSort};
  Sort(Lo,Hi);
end;

begin
 assign(f,'infasuratoare.in'); reset(f);
assign(g,'infasuratoare.out'); rewrite(g);
read(f,n);
maxx:=maxlongint; maxy:=maxlongint;
for i:=1 to n do begin
read(f,v[i].x,v[i].y);
if (maxx=v[i].x) and (maxy>v[i].y)  then begin
                                        maxc:=i;
                                        maxx:=v[i].x;
                                        maxy:=v[i].y;
                                         end;
if maxx>v[i].x then begin maxc:=i;
                        maxy:=v[i].y;
                        maxx:=v[i].x;
                        end;
end;
aux:=v[maxc];
v[maxc]:=v[1];
v[1]:=aux;
quicksort(v,2,n);

st[1]:=v[1];
st[2]:=v[2];
st[3]:=v[3];
nn:=3;
I:=4;
while i<=n do begin
{ j:=i+1; max:=sqrt(sqr(v[i].x-v[1].x)+sqr(v[i].y-v[1].y));  ii:=i+1;
 while (j<=n) and (abs((v[j].x-v[1].x)*(v[i].y-v[1].y)-((v[i].x-v[1].x)*(v[j].y-v[1].y)))<0.000000000000001) do
 begin
 if  sqrt(sqr(v[j].x-v[1].x)+sqr(v[j].y-v[1].y))>max then begin
                        max:=sqrt(sqr(v[j].x-v[1].x)+sqr(v[j].y-v[1].y));
                          i:=j;
                                                          end;
 inc(j); ii:=j;
 end;    }
if (st[nn-1].x*st[nn].y+st[nn].x*v[i].y+v[i].x*st[nn-1].y)-
   st[nn-1].x*v[i].y-st[nn].x*st[nn-1].y-v[i].x*st[nn].y<0 then
   dec(nn)
   else begin inc(nn); st[nn]:=v[i]; i:=i+1; end;
end;
writeln(g,nn);
for i:=1 to nn do writeln(g,st[i].x:0:6,' ',st[i].y:0:6);

close(g);
end.