Cod sursa(job #291029)

Utilizator bixcabc abc bixc Data 29 martie 2009 11:47:48
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.86 kb
const DIM = 120000;
var n,i,j,nst,ini:longint;
    x,y: array[1..DIM] of double;
    f: text;
    mx,my,aux: double;
    st: array [1..DIM] of longint;

function det (p1,p2,p3 : longint) : double;
begin
det := (x[p2]-x[p1]) * (y[p3]-y[p1]) + (x[p3]-x[p1]) * (y[p1]-y[p2]);
end;

function mai_mic (a, b:longint):boolean;
var x1, x2, y1, y2 : double;
begin
x1 := x[a]; y1 := y[a];
x2 := x[b]; y2 := y[b];
if (x1*y2<>x2*y1) then begin
  mai_mic:= x1*y2>x2*y1;
  exit;
end;
mai_mic:= x1*x1 + y1*y1 > x2*x2 + y2*y2;
end;

procedure Sort(l, r: longint);
var
  i, j, xx : longint;
begin
  i := l; j := r; xx := (l+r) DIV 2;
  repeat
    while mai_mic(i,xx) do i := i + 1;
    while mai_mic(xx,j) do j := j - 1;
    if i <= j then
    begin
      aux := x[i]; x[i] := x[j]; x[j] := aux;
      aux := y[i]; y[i] := y[j]; y[j] := aux;
      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
assign  (f,'infasuratoare.in');
reset   (f);
readln  (f,n);
ini:=n;
for i:=1 to n do
    begin
    readln (f, x[n-i+1], y[n-i+1]);

    if (y[i]<y[ini]) or ((y[i]=y[ini]) and (x[i] < x[ini])) then
             ini := i;
    end;

{mx:=x[ini];
my:=y[ini];}

aux := x[1];
x[1] := x[ini];
x[ini] := aux;
aux := y[1];
y[1] := y[ini];
y[ini] := aux;


for i:=1 to n do
begin
x[i]:=x[i]-mx;
y[i]:=y[i]-my;
end;


close   (f);

{pct[ini]:=1;
pct[1]:=ini;}

Sort(2,n);
{for i:=1 to n do
       write;
}
nst:=2;
st[1]:=1;
st[2]:=2;

for i:=3 to n do
    begin
    while (nst>2) and  (det (st[nst-1], st[nst], i) <= 0 )do
          dec(nst);
    inc(nst);
    st[nst]:=i;
    end;
assign(f,'infasuratoare.out');
rewrite(f);

writeln(f,nst);
for i:=1 to nst do
    writeln(f,x[st[i]]+mx:0:6,' ',y[st[i]]-my:0:6);
close(f);

end.