Cod sursa(job #679848)

Utilizator MihaiBunBunget Mihai MihaiBun Data 13 februarie 2012 19:51:19
Problema Infasuratoare convexa Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 kb
program kk;
var f:text;
    i,n,p,q,nr:longint;
    x,y:array[1..120000] of extended;
    a:array[1..120000] of longint;
    min:extended;

function gaseste(j:longint):longint;
var u,v:longint;
    t,t1,t2,cosa,min1:extended;
begin
  u:=a[j-1];
  v:=a[j];
  t:=sqr(x[u]-x[v])+sqr(y[u]-y[v]);
  min1:=2;
  for i:=1 to n do
    if (i<>u)and(i<>v)then
      begin
        t1:=sqr(x[i]-x[v])+sqr(y[i]-y[v]);
        t2:=sqr(x[u]-x[i])+sqr(y[u]-y[i]);
        cosa:=(t+t1-t2)/(2*sqrt(t)*sqrt(t1));
        if cosa<min1 then begin min1:=cosa;q:=i;end;
      end;
  gaseste:=q;
end;

begin
  assign(f,'infasuratoare.in');
  reset(f);
  min:=2000000000;
  readln(f,n);
  for i:=1 to n do
    begin
      readln(f,x[i],y[i]);
      if x[i]<min then begin min:=x[i];p:=i;end
                  else if x[i]=min then
                           if y[i]<y[p] then p:=i;

    end;
  a[1]:=p;
  nr:=1;
  min:=2000000000;
  for i:=1 to n do
    if i<>a[1] then
      if y[i]<min then begin min:=y[i];q:=i;end;
  a[2]:=q;
  nr:=2;
  repeat
    p:=gaseste(nr);
    nr:=nr+1;
    a[nr]:=p;
  until p=a[1];
  nr:=nr-1;
  close(f);
  assign(f,'infasuratoare.out');
  rewrite(f);
  writeln(f,nr);
  for i:=1 to nr do writeln(f,x[a[i]],' ',y[a[i]]);
  close(f);
end.