Cod sursa(job #945321)

Utilizator VictorVrabieVrabie Victor VictorVrabie Data 1 mai 2013 18:05:12
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.06 kb
const nmax=120009;
type list=array[0..nmax] of longint;
var i,n,k:longint; s:real; f1,f2:text;
    x,y:array[0..nmax] of real;
    ind,st:list;
procedure qsort(var ind:list);
 procedure sort(l,r: longint);
      var
         i,j,t:longint;
         mx,my:real;
      begin
         i:=l;
         j:=r;
         mx:=x[ind[(l+r) div 2]];
         my:=y[ind[(l+r) div 2]];
         repeat
           while (y[ind[i]]-y[k])*(mx-x[k])<(my-y[k])*(x[ind[i]]-x[k]) do
            inc(i);
           while (my-y[k])*(x[ind[j]]-x[k])<(y[ind[j]]-y[k])*(mx-x[k]) do
            dec(j);
           if not(i>j) then
             begin
                t:=ind[i];
                ind[i]:=ind[j];
                ind[j]:=t;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;
  begin
       sort(1,ind[0]);
end;
function semn(v1,v2,v3:longint):real;
  begin
    semn:=x[v1]*y[v2]+x[v2]*y[v3]+x[v3]*y[v1]-x[v3]*y[v2]-x[v2]*y[v1]-x[v1]*y[v3];
  end;
{function f(i,j,k:integer):real;
var x1,x2,x3,y1,y2,y3:real;
begin
x1:=x[i];
x2:=x[j];
x3:=x[k];
y1:=y[i];
y2:=y[j];
y3:=y[k];
f:=abs(x1*y2+x3*y1+x2*y3-x3*y2-x1*y3-x2*y1)/2;
end; }
begin
  assign(f1,'infasuratoare.in');
  assign(f2,'infasuratoare.out');
  reset(f1);
  rewrite(f2);
  readln(f1,n);
  k:=1;
  for i:=1 to n do
begin
readln(x[i],y[i]);
        if (x[i]<x[k]) or ((x[i]=x[k]) and (y[i]<y[k])) then
                k:=i;
  end;
  for i:=1 to n do
        if i<>k then begin
                inc(ind[0]);
                ind[ind[0]]:=i;
        end;
qsort(ind);
 st[1]:=k;
  st[0]:=1;
  for i:=1 to ind[0] do begin
    while (st[0]>=2) and (semn(st[st[0]-1],st[st[0]],ind[i])<0) do
        dec(st[0]);
    inc(st[0]);
    st[st[0]]:=ind[i];
  end;
writeln(st[0]);
  for i:=1 to st[0] do writeln(x[st[i]]:16:6,' ',y[st[i]]:16:6);
                      { s:=0;
for i:=2 to st[0]-1 do
s:=s+f(1,i,i+1);
writeln(f2,s:0:2);     }
close(f2);
  close(f1);
end.