Cod sursa(job #872999)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 6 februarie 2013 19:59:07
Problema Infasuratoare convexa Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 3.03 kb
program adas;
type vect=array[1..120000]of real;
     vector=array[1..100000]of longint;
var n,i,j,k,semn,p,contor,imin:longint;  aux,min:real;
    x,y,xx,yy:vect;v:vector;
    ok,ok1,ok2:boolean;
    f,g:text;
function ec(x1,y1,x2,y2,x,y:real):real;
begin
ec:=(x-x1)*(y2-y1)-(y-y1)*(x2-x1);
end;
procedure afisare(x,y:real);
begin
writeln(g,x:14:12,' ',y:14:12);
end;
begin
assign(f,'infasuratoare.in');reset(f);
assign(g,'infasuratoare.out');rewrite(g);
readln(f,n);
for i:=1 to n do readln(f,x[i],y[i]);
contor:=0;
for i:=1 to n do
 for j:=1 to n do
  if i<>j then begin
               p:=1;while (p=i)or(p=j) do inc(p);
               if ec(x[i],y[i],x[j],y[j],x[p],y[p])>0 then semn:=1
               else if ec(x[i],y[i],x[j],y[j],x[p],y[p])<0 then semn:=-1;
               ok:=true;
               k:=1;
               while (k<=n)and ok do begin
                                     if (k<>i) and(k<>j) then
                                       begin
                                       if semn<0 then
                                         if ec(x[i],y[i],x[j],y[j],x[k],y[k])>0 then ok:=false;
                                       if semn>0 then
                                         if ec(x[i],y[i],x[j],y[j],x[k],y[k])<0 then ok:=false;
                                       end;
                                     inc(k);
                                     end;
               if ok then begin
                          ok1:=true;ok2:=true;
                          for p:=1 to contor do begin
                                                if v[p]=i then ok1:=false;
                                                if v[p]=j then ok2:=false;
                                                end;
                          if ok1 then begin inc(contor);v[contor]:=i;end;
                          if ok2 then begin inc(contor);v[contor]:=j;end;
                          {writeln(g,x[i],' ',y[i],' ',x[j],' ',y[j]);}
                          end;
               end;
for i:=1 to contor do begin xx[i]:=x[v[i]];yy[i]:=y[v[i]];end;
for i:=1 to contor-1 do
 for j:=i+1 to contor do
   if xx[i]>xx[j] then begin
                       aux:=xx[i];xx[i]:=xx[j];xx[j]:=aux;
                       aux:=yy[i];yy[i]:=yy[j];yy[j]:=aux;
                       end
   else if xx[i]=xx[j] then
          if yy[i]>yy[j] then begin
                              aux:=yy[i];yy[i]:=yy[j];yy[j]:=aux;
                              end;
writeln(g,contor);
min:=10001;
for i:=1 to contor do
 if yy[i]<min then begin min:=yy[i];imin:=i;end;// writeln(g,imin);
afisare(xx[imin],yy[imin]);
for i:=imin+1 to contor do if yy[i]<yy[contor] then afisare(xx[i],yy[i]);
afisare(xx[contor],yy[contor]);
for i:=contor downto imin+1 do if yy[i]>yy[contor] then afisare(xx[i],yy[i]);
for i:=imin-1 downto 1 do if yy[i]>yy[1] then afisare(xx[i],yy[i]);
afisare(xx[1],yy[1]);
for i:=2 to imin-1 do if yy[i]<yy[1] then afisare(xx[i],yy[i]);



//for i:=1 to contor do writeln(g,xx[i]:14:12,' ',yy[i]:14:12);
close(f);close(g);
end.