Cod sursa(job #1140298)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 11 martie 2014 21:36:52
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.28 kb
program infas;

    type point=record
         x,y:real;
         end;
    var a,st:array[1..120000] of point;
        n,i,k,orig:longint;
        p:array[1..120000] of real;
        aux:point;
    procedure readData;
     begin
     assign(input,'infasuratoare.in');
     reset(input);
     readln(n);
     for i:=1 to n do readln(a[i].x,a[i].y);
     close(input);
     end;

    procedure WriteSolution(k:longint);
     begin
      assign(output,'infasuratoare.out');
      rewrite(output);
      writeln(k);
      for i:=1 to k do writeln(st[i].x:0:6,' ',st[i].y:0:6);
      close(output);
     end;

    procedure sort(l,r:longint);
     var aux,m:real;
         aux1:point;
         i,j:longint;
     begin
       i:=l;
       j:=r;
       m:=p[(i+j) div 2];
       repeat
         while p[i]<m do inc(i);
         while p[j]>m do dec(j);
         if i<=j then
                 begin
                   aux:=p[i];
                   p[i]:=p[j];
                   p[j]:=aux;
                   aux1:=a[i];
                   a[i]:=a[j];
                   a[j]:=aux1;
                   inc(i);
                   j:=j-1;
                 end;
       until (i>j);
       if (i<r) then sort(i,r);
       if (j>l) then sort(l,j);
     end;


    function sarrus(p1,p2,p3:point):real;
      begin
         sarrus:=p1.x*p2.y+p2.x*p3.y+p1.y*p3.x
                -p3.x*p2.y-p3.y*p1.x-p1.y*p2.x;
      end;


   begin
    ReadData;
    orig:=1;
    for i:=2 to n do
      if (a[orig].x>a[i].x) or ((a[orig].x=a[i].x) and (a[orig].y>a[i].y))
        then orig:=i;
    aux:=a[1];
    a[1]:=a[orig];
    a[orig]:=aux;
    {assign(output,'infasuratoare.out'); rewrite(output); }

    for i:=2 to n do
      if a[1].x=a[i].x then p[i]:=1 shl 20
        else p[i]:=(a[i].y-a[1].y)/(a[i].x-a[1].x);

    sort(2,n);

   {for i:=1 to n do begin
                write(p[i]:0:2,'     ');
                writeln(a[i].x:0:4,' ',a[i].y:0:4);
                     end; }

    st[1]:=a[1];
    st[2]:=a[2];
    k:=2;

    for i:=3 to n  do
      begin
        while (sarrus(st[k-1],a[i],st[k])>=0) and (k>1) do dec(k);
        inc(k);
        st[k]:=a[i];
      end;
   WriteSolution(k);
   {close(output); }
   end.