Cod sursa(job #730522)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 6 aprilie 2012 13:41:12
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.76 kb
Program convex_algoritm_graham;
var fi,fo : text;
    i,n,poz : longint; px,py,q:extended;
    p,x,y:array[0..120000] of extended;
    t:array[0..120000] of longint;

Function sarrus(p1_x,p1_y,p2_x,p2_y,p3_x,p3_y:extended):extended;
begin
    sarrus:=p1_x*p2_y+p2_x*p3_y+p3_x*p1_y
           -p2_y*p3_x-p3_y*p1_x-p1_y*p2_x;
end;

Procedure swap(var a,b:extended);
begin
     q:=a; a:=b; b:=q;
end;

Function polar(x,y:extended):extended;
begin
    if x>0 then begin
                if y>0 then polar:=arctan(y/x)
                       else polar:=arctan(y/x)+2*pi;
                end
           else if x<0 then polar:=arctan(y/x)+pi
                       else if x=0 then begin
                                        if y>0 then polar:=pi/2
                                               else if y<0 then polar:=3*pi/2
                                                           else polar:=0;
                                        end;
end;

Procedure quick(left,right:longint);
var i,j:longint;  r:extended;
begin
    r:=p[(left+right) div 2];
    i:=left; j:=right;

    while i<j do begin
          while p[i]<r do i:=i+1;
          while p[j]>r do j:=j-1;
          if i<=j then begin
                       swap(x[i],x[j]); swap(y[i],y[j]); swap(p[i],p[j]);
                       i:=i+1; j:=j-1;
                       end;
                 end;

    if j>left then quick(left,j);
    if i<right then quick(i,right);
end;

begin
    assign(fi,'infasuratoare.in'); reset(fi); readln(fi,n);
    assign(fo,'infasuratoare.out'); rewrite(fo); readln(fi,x[1],y[1]);
    px:=x[1]; py:=y[1];
    for i:=2 to n do begin
                     readln(fi,x[i],y[i]);
                     if y[i]<py then begin py:=y[i]; px:=x[i]; end;
                     end;

    for i:=1 to n do p[i]:=polar(x[i]-px,y[i]-py);
    quick(1,n);   poz:=2; t[1]:=1; t[2]:=2;

    for i:=3 to n do begin
                     if sarrus(x[i],y[i],x[t[poz-1]],y[t[poz-1]],
                     x[t[poz]],y[t[poz]])>0 then begin
                                                  poz:=poz+1;
                                                  t[poz]:=i;
                                                  end
                                              else begin
                                                  while sarrus(x[i],y[i],x[t[poz-1]],y[t[poz-1]],
                                                        x[t[poz]],y[t[poz]])<0 do poz:=poz-1;
                                                  poz:=poz+1;
                                                  t[poz]:=i;
                                                  end;
                     end;
    writeln(fo,poz);
    for i:=1 to poz do writeln(fo,x[t[i]]:0:6,' ',y[t[i]]:0:6);
    close(fi); close(fo);
end.