Cod sursa(job #1042912)

Utilizator IonMosnoiIon Mosnoi IonMosnoi Data 27 noiembrie 2013 19:45:42
Problema Infasuratoare convexa Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.75 kb
program t1;
var i,j,n,min:integer;
x,y,t:array[1..120000] of extended;
r:array[1..120000] of integer;
y1,x1:extended;
procedure sort(l,r: longint);
      var
         i,j:longint;
         x1,y1:extended;
      begin
         i:=l;
         j:=r;
         x1:=t[(l+r) div 2];
         repeat
           while t[i]<x1 do
            inc(i);
           while x1<t[j] do
            dec(j);
           if not(i>j) then
             begin
                y1:=t[i];
                t[i]:=t[j];
                t[j]:=y1;
                y1:=x[i];
                x[i]:=x[j];
                x[j]:=y1;
                y1:=y[i];
                y[i]:=y[j];
                y[j]:=y1;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;
begin
      assign(input,'infasuratoare.in');
      reset(input);
      assign(output,'infasuratoare.out');
      rewrite(output);
      readln(n);        min:=1;
      for i:=1 to n do
       begin
         readln(x[i],y[i]);

         if (x[min]>x[i]) then min:=i;
                  end;

      for i:=1 to n do if x[min]=x[i] then
      if y[min]>y[i] then min:=i;

            x1:=x[1];y1:=y[1];
            x[1]:=x[min];y[1]:=y[min];
            x[min]:=x1;y[min]:=y1;
            t[1]:=0;

       for i:=2 to n do

         if x[1]<>x[i] then
         t[i]:=(y[1]-y[i])/(x[1]-x[i]) else t[i]:=1000000000000000;

          {
      for i:=1 to n-1 do
       for j:=i+1 to n do begin
        if((i<>min)and(j<>min) and (t[i]>t[j])) then begin
         k:=t[i];
         t[i]:=t[j];
         t[j]:=k;
         k:=x[i];
         x[i]:=x[j];
         x[j]:=k;
         k:=y[i];
         y[i]:=y[j];
         y[j]:=k;
        end;
            if((i<>min)and(j<>min) and (t[i]=t[j]) and(x[i]>x[j])) then begin
              k:=t[i];
         t[i]:=t[j];
         t[j]:=k;
         k:=x[i];
         x[i]:=x[j];
         x[j]:=k;
         k:=y[i];
         y[i]:=y[j];
         y[j]:=k;
            end;
        end;
                  }

          sort(2,n);
         { for i:=1 to n do write(t[i]:4:4,' ');writeln;  }
           r[1]:=1;
           r[2]:=2;


       i:=3;       j:=3;
       while i<=n do

       if(((x[r[j-1]]-x[r[j-2]])*(y[i]-y[r[j-2]]))-((x[i]-x[r[j-2]])*(y[r[j-1]]-y[r[j-2]])))>0 then
              begin
                  r[j]:=i;

                  inc(i);inc(j);
              end
              else
              begin
                    r[j-1]:=0;    dec(j);

              end;


       writeln(j-1);

        for i:=1 to j-1 do writeln(x[r[i]]:10:10,' ',y[r[i]]:10:10);
      close(input);close(output);
end.