Cod sursa(job #1756033)

Utilizator medicinedoctoralexandru medicinedoctor Data 11 septembrie 2016 17:36:58
Problema Infasuratoare convexa Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.6 kb
type point=record
  x,y,a:real;
end;

var h,a:array [1..100000] of point;
minp:point;
m,n:longint;

procedure sw(var a,b:point);
var c:point;
begin
  c:=a;
  a:=b;
  b:=c;
end;

procedure qs(le,ri:longint);
var i,j:longint; p:point;
begin
  i:=le; j:=ri; p:=a[(i+j) div 2];
  while (i<j) do
  begin
    while a[i].a<p.a do i:=i+1;
    while a[j].a>p.a do j:=j-1;
    if i<=j then
    begin
      sw(a[i],a[j]);
      i:=i+1;
      j:=j-1;
    end;
  end;
  if (i<ri) then qs(i,ri);
  if (le<j) then qs(le,j);
end;

procedure ca;
var i:longint;
x1,x2:real;
begin
  for i:=1 to n do
  begin
    x1:=a[i].y-minp.y;
    x2:=a[i].x-minp.x;
    if (x1=0) and (x2=0) then a[i].a:=1.1 else
    a[i].a:=x1*abs(x1)/(x1*x1+x2*x2);
  end;
  qs(1,n);
end;

procedure init;
var i:longint;
begin
  readln(n);
  read(a[1].x,a[1].y);
  minp:=a[1];
  for i:=2 to n do
  begin
    read(a[i].x,a[i].y);
    if (a[i].x<minp.x) or (a[i].x=minp.x) and (a[i].y<minp.y)
    then minp:=a[i];
  end;
  ca;
end;

function det(a,b,c:point):real;
begin
  det:=a.x*b.y+b.x*c.y+c.x*a.y-c.x*b.y-b.x*a.y-a.x*c.y;
end;

procedure hull;
var i:longint;
begin
  m:=3;
  for i:=1 to 3 do
    h[i]:=a[i];
  for i:=4 to n do
  begin
    m:=m+1;
    h[m]:=a[i];
    while (m>2) and (det(h[m-2],h[m-1],h[m]) <=0) do
    begin
      h[m-1]:=h[m];
      m:=m-1;
    end;
  end;
  writeln(m);
  for i:=1 to m do
    writeln(h[i].x,' ',h[i].y);
end;

begin
  assign(input,'infasuratoare.in');
  assign(output,'infasuratoare.out');
  reset(input);
  rewrite(output);
  init;
  hull;
end.