Cod sursa(job #1412554)

Utilizator Stefan.Andras Stefan Stefan. Data 1 aprilie 2015 12:48:40
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.64 kb
program infasuratoare2;
const nmax = 120001;
type coordonata = record
                x,y : real;
                end;
var f,g:text;
    n,i,q,k:longint;
    stiva:array[1..nmax] of longint;
    v:array[1..nmax] of coordonata;
    ok:array[1..nmax] of boolean;
//------------------------------------------
function pivot(st, dr:longint):longint;
var aux, i, j, dj, di:longint;
    aux2:coordonata;
begin
        i := st; j := dr;
        di := 0; dj := 1;
        while i < j do
                begin
                  if (v[i].x > v[j].x) or ((v[i].x = v[j].x) and (v[i].y > v[j].y)) then
                        begin
                          aux2 := v[i];
                          v[i] := v[j];
                          v[j] := aux2;
                          aux := di;
                          di := dj;
                          dj := aux;
                        end;
                  i := i + di;
                  j := j - dj;
                end;
        pivot := i;
end;
//------------------------------------
procedure sort(st,dr:longint);
var p:longint;
begin
        if st < dr then
                begin
                  p := pivot(st, dr);
                  sort(st, p-1);
                  sort(p+1,dr);
                end;

end;
//----------------------------------------
function det(a,b,c:coordonata):real;
begin
        det:=(a.x*b.y)+(b.x*c.y)+(c.x*a.y)-(b.y*c.x)-(c.y*a.x)-(a.y*b.x);
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, v[i].x, v[i].y);
        //----------------------------------------
        sort(1,n);
        //----------------------------------------
        stiva[1] := 1;
        stiva[2] := 2;
        ok[2] := true;
        k := 2;
        i := 3;
        q := 1;
        while not ok[1] do
                begin
                  while ok[i] do
                        begin
                          if i = n then q := -1;
                          i := i + q;
                        end;
                  while (k >= 2) and (det(v[stiva[k-1]], v[stiva[k]], v[i]) < 0) do
                        begin
                          ok[stiva[k]] := false;
                          dec(k);
                        end;
                  inc(k);
                  stiva[k] := i;
                  ok[i] := true;
                end;
        writeln(g,k-1);
        for i := 1 to k - 1 do
                writeln(g,v[stiva[i]].x:0:6,' ', v[stiva[i]].y:0:6);
        close(f); close(g);
end.