Cod sursa(job #1142617)

Utilizator Vasile_Catananoname Vasile_Catana Data 13 martie 2014 23:27:07
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.84 kb
program p1;
var x,y,a:array[0..120000] of extended;
    f,g:text;
    b1,b2:array[0..1 shl 17 ] of char;
    i,j,u,h,m,n,k,poz:longint;
    k1,k2:array[0..120000] of extended;
    maxx,maxy,aux:extended;
procedure Sort(l, r: longint);
var
  i, j: longint;
  u,aux:extended;
begin
  i := l; j := r; u := a[(l+r) DIV 2];
  repeat
    while a[i] < u do i := i + 1;
    while u < a[j] do j := j - 1;
    if i <= j then
    begin
      aux:= a[i]; a[i] := a[j]; a[j] := aux;
      aux:=x[i]; x[i]:=x[j]; x[j]:=aux;
      aux:=y[i]; y[i]:=y[j]; y[j]:=aux;
    end;
      i := i + 1; j := j - 1;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;
function sarrus(x1,y1,x2,y2,x3,y3:extended):extended;
begin
 sarrus:=x1*y2+x2*y3+x3*y1-y2*x3-y3*x1-y1*x2;
end;
begin
assign(f,'infasuratoare.in');reset(F);
assign(g,'infasuratoare.out');rewrite(G);
settextbuf(f,b1);
settextbuf(g,b2);
 readln(f,n);
{ maxx:=x[1];
 maxy:=y[1];}
 poz:=1;
 for i:=1 to n do begin
        readln(f,x[i],y[i]);
        if (x[poz]>x[i]) or ((x[poz]=x[i]) and (y[poz]>y[i]))then
                begin
               { maxx:=x[i];
                maxy:=y[i]; }
                poz:=i;
                end;
                  END;
 aux:=x[1];
 x[1]:=x[poz];
 x[poz]:=aux;
 aux:=y[1];
 y[1]:=y[poz];
 y[poz]:=aux;

 for i:=1to n do
        if x[1]-x[i]=0 then a[i]:=32131312312321312
                 else a[i]:=(y[i]-y[1])/(x[i]-x[1]);
 sort(2,n);k:=2;
 k1[1]:=x[1];
 k1[2]:=x[2];
 k2[1]:=y[1];
 k2[2]:=y[2];
  for i:=3 to n do begin
        while (sarrus(k1[k-1],k2[k-1],x[i],y[i],k1[k],k2[k])>=0)and(k>1) do dec(K);
        inc(K);
        k1[k]:=x[i];
        k2[k]:=y[i];
                  end;
  writeln(g,k);
 for i:=1 to k do writeln(g,k1[i]:0:6,' ',k2[i]:0:6);
close(F);
close(G);
end.