Cod sursa(job #1754401)

Utilizator elffikkVasile Ermicioi elffikk Data 8 septembrie 2016 06:22:53
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.83 kb
type Point=record
  X, Y, A: Real;
end; 

var h, a:array[1..120000] of Point;
    m, n:longint;
    minP:Point;

procedure init;
var i:longint;
begin  
  readln(n);
  for i:=1 to n do readln(a[i].X, a[i].Y);
end;

procedure computeMin;
var i:longint;
begin
  minP := a[1];
  for i:=2 to n do
    if (minP.X>a[i].X) or (minP.X=a[i].X)and(minP.Y>a[i].Y)
    then minP:=a[i];    
end;

procedure computeAngle;
var i:longint;
    c1,c2:real;
begin
  for i:=1 to n do
  begin
    c1:=a[i].Y-minP.Y;
    c2:=a[i].X-minP.X;
    if (c1=0)and(c2=0)
    then a[i].A := 1.1
    else a[i].A:=c1*abs(c1)/(c1*c1+c2*c2);
  end;
end;

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

procedure qs(left, right:longint);
var i, j:longint;  
    p:Point;  
begin
  i:=left; j:=right; 
  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 left<j then qs(left, j);
  if i<right then qs(i, right);  
end;

function det(p1,p2,p3: Point):real;
begin
  det:=p1.X*p2.Y+p2.X*p3.Y+p3.X*p1.Y-p1.X*p3.Y-p2.X*p1.Y-p3.X*p2.Y;
end;

procedure hull;
var i:longint;
begin
  m:=3;
  for i:=1 to m 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;
end;

procedure afisHull;
var i:longint;
begin
  writeln(m);
  for i:=1 to m do
    writeln(h[i].X,' ', h[i].Y);
end;
    
begin
  assign(input, 'infasuratoare.in');
  reset(input);
//  assign(output, 'infasuratoare.out');
//  rewrite(output);
  init;
  computeMin;
  computeAngle;
  qs(1, n);
  hull;
  afisHull;  
end.