Cod sursa(job #977889)

Utilizator george_stelianChichirim George george_stelian Data 26 iulie 2013 22:59:53
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.38 kb
type inf=record
x,y:real;
end;
var f,g:text;v,v1:array[1..120000]of inf;a:inf;minx,miny:real;i,n,nr,x,y,j:longint;

procedure sort(st,dr:longint);
var i,j:longint;
begin
i:=st;j:=dr;x:=(i+j)div 2;
repeat
while(v[i].y-v[1].y)*(v[x].x-v[1].x)>(v[i].x-v[1].x)*(v[x].y-v[1].y)do inc(i);
while(v[j].y-v[1].y)*(v[x].x-v[1].x)<(v[j].x-v[1].x)*(v[x].y-v[1].y)do dec(j);
if i<=j then begin
a:=v[i];v[i]:=v[j];v[j]:=a;
inc(i);dec(j);
             end;
until i>j;
if st<j then sort(st,j);
if i<dr then sort(i,dr);
end;

procedure sort1(st,dr:longint);
var i,j:longint;
begin
i:=st;j:=dr;x:=(i+j)div 2;
repeat
while v[i].y<v[x].y do inc(i);
while v[j].y>v[x].y do dec(j);
if i<=j then begin
a:=v[i];v[i]:=v[j];v[j]:=a;
inc(i);dec(j);
             end;
until i>j;
if st<j then sort1(st,j);
if i<dr then sort1(i,dr);
end;

function directie(x1,y1,x2,y2,x3,y3:real):byte;
begin
if(x2-x1)*(y3-y1)-(y2-y1)*(x3-x1)<0 then directie:=1
                                    else directie:=2;
end;

begin
assign(f,'infasuratoare.in');reset(f);assign(g,'infasuratoare.out');rewrite(g);
read(f,n);
minx:=1000000000;
miny:=1000000000;
for i:=1 to n do begin
read(f,v[i].x,v[i].y);
if v[i].x<minx then begin minx:=v[i].x;
                         nr:=i;
                         miny:=v[i].y;
                   end
              else if(v[i].x=minx)and(v[i].y<miny)then begin nr:=i;
                                                             miny:=v[i].y;
                                                       end;
                 end;
a:=v[1];
v[1]:=v[nr];
v[nr]:=a;
sort(2,n);
y:=2;
minx:=v[2].x;
for i:=3 to n do
if v[i].x<>minx then begin
sort1(y,i-1);
y:=i;
minx:=v[i].x;
                     end;
sort1(y,n);
v1[1].x:=v[1].x;
v1[1].y:=v[1].y;
v1[2].x:=v[2].x;
v1[2].y:=v[2].y;
nr:=2;
for i:=3 to n do begin
while directie(v1[nr-1].x,v1[nr-1].y,v1[nr].x,v1[nr].y,v[i].x,v[i].y)=2 do dec(nr);
inc(nr);
v1[nr].x:=v[i].x;
v1[nr].y:=v[i].y;
                 end;
writeln(g,nr);
for i:=nr downto 1 do begin
x:=trunc(v1[i].x);
j:=0;
while x>0 do begin
inc(j);
x:=x div 10;
             end;
if j=0 then j:=1;
write(g,v1[i].x:j:6,' ');
x:=trunc(v1[i].y);
j:=0;
while x>0 do begin
inc(j);
x:=x div 10;
             end;
if j=0 then j:=1;
writeln(g,v1[i].y:j:6);
                      end;


close(f);close(g);
end.