Cod sursa(job #1754181)

Utilizator elffikkVasile Ermicioi elffikk Data 7 septembrie 2016 17:10:56
Problema Infasuratoare convexa Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.93 kb
type Point=record
  X,Y: double;
end;

type Range=record
    I, J: longint;
end;    

var h, a:array[1..120000] of Point;
    stack: array[1..120000] of Range;
    m, n, stackN:longint;
    
procedure init;
var i:longint;
begin  
  readln(n);
  for i:=1 to n do readln(a[i].X, a[i].Y);
end;

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

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

function det(p1,p2,p3: Point):double;
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 qs;
var i, j, left, right:longint; p:Point;
begin
  while stackN > 0 do
  begin
    left:=stack[stackN].I; right:=stack[stackN].J;
    i:=left; j:=right; p:=a[(i+j) div 2];
    stackN:=stackN-1;
    while i<j do
    begin
      while det(a[1], p, a[i])<0 do i:=i+1;
      while det(a[1], p, a[j])>0 do j:=j-1;
      if i<=j then begin
        sw(a[i], a[j]);
        i:=i+1;
        j:=j-1;
      end;
    end;
    if i<right then begin stackN:=stackN+1; stack[stackN].I:=i; stack[stackN].J:=right; end;
    if left<j then begin stackN:=stackN+1; stack[stackN].I:=left; stack[stackN].J:=j; end;
  end;
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;  
  stackN:=1;
  stack[1].I := 2;
  stack[1].J := N;
  qs;
  hull;
  afisHull;  
end.