Cod sursa(job #1396402)

Utilizator Stefan.Andras Stefan Stefan. Data 22 martie 2015 14:53:47
Problema Infasuratoare convexa Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.75 kb
program infasuratoarea;
type cord = record
                x,y:real;
                end;
var f,g:text;
    n,i,q,k,h:longint;
    v:array[1..120001] of cord;
    stiva:array[1..120001] of longint;
    ok:array[1..120001] of byte;
function pivot(st,dr:integer):longint;
var aux,i,j,di,dj:longint;
    aux2:cord;
begin
   i:=st;
   j:=dr;
   di:=0;
   dj:=1;
   while i < j do
      begin
      if (v[i].x > v[j].x) then  //crescator dupa X, in caz de egalitate, crescator dupa Y
         begin
         aux2:=v[i];
         v[i]:=v[j];
         v[j]:=aux2;
         aux:=di;
         di:=dj;
         dj:=aux;
         end
      else
        if (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:cord):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);
        //rezolvare !!
        stiva[1]:=1;  //se initializeaza stiva, cel mai din stanga punct (sigur pe infasuratoare)
        stiva[2]:=2;  //cel de-al 2-lea punct, care urmeaza sa fie verificat
        ok[2]:=1; //va contoriza introducerea sau scoaterea unui pct din stiva
        k:=2; //nr de element din stiva
        i:=3; //indicele punctului care urmeaza sa fie comparat
        q:=1;
        //cat timp nu s-a inchis poligonul
        while ok[1] = 0 do
                begin
                //se cauta un punct neutilizat (nevizitat)
                while ok[i] = 1 do
                        begin
                        if i = n then q:=-1;
                        i:=i+q;
                        end;
                //verific daca punctele respecta propietate
                while (k >= 2) and (det(v[stiva[k-1]], v[stiva[k]], v[i]) < 0.00000000001) do
                        begin
                        ok[stiva[k]]:=0;
                        dec(k);
                        end;
                inc(k);
                stiva[k]:=i;
                ok[i]:=1;
                end;
        h:=k-1;
        writeln(g,h);
        for i:=2 to h+1 do
                writeln(g,v[stiva[i]].x:0:6,' ',v[stiva[i]].y:0:6);
        close(f); close(g);
end.