Cod sursa(job #286039)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 23 martie 2009 12:55:41
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.75 kb
var n,i,j,nst,ini:longint;
    x,y: array[1..120000] of double;
    f: text;
    mx,my: double;
    st,pct: array [1..120000] 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, yy : longint;
begin
  i := l; j := r; xx := (l+r) DIV 2;
  repeat
    while mai_mic(pct[i],pct[xx]) do i := i + 1;
    while mai_mic(pct[xx],pct[j]) do j := j - 1;
    if i <= j then
    begin
      yy := pct[i]; pct[i] := pct[j]; pct[j] := yy;
      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:=1;
for i:=1 to n do
    begin
    readln (f, x[i], y[i]);
    pct[i] := i;
    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];

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]:=pct[1];
st[2]:=pct[2];

for i:=3 to n do
    begin
    while (nst>2) and  (det (st[nst-1], st[nst], pct[i]) <= 0 )do
          dec(nst);
    inc(nst);
    st[nst]:=pct[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.