Cod sursa(job #1042857)

Utilizator IonMosnoiIon Mosnoi IonMosnoi Data 27 noiembrie 2013 19:02:04
Problema Infasuratoare convexa Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.97 kb
program t1;
var i,j,n,min,l:integer;
x,y,c,t:array[1..1200] of real;
r:array[1..1000] of integer;
sc,k:real;
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;
       for i:=1 to n do
        if i<>min then    begin
         if x[min]<>x[i] then
         t[i]:=(y[min]-y[i])/(x[min]-x[i]) else t[i]:=100000; end;


      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;

      {  for i:=1 to n do writeln(t[i]:2:2,' ',x[i]:2:2,' ',y[i]:2:2);}

          r[1]:=min;
       if min<>1 then   r[2]:=1 else r[2]:=2;


       i:=1;       j:=3;    k:=0;
       while i<=n do begin
           if ((i<>min)and (i<>r[2])) then begin
       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;
           end else  inc(i);
       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.