Cod sursa(job #1754304)

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

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

var h, a:array[1..120000] of Point;
    m, n: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:longint;
    sorted: boolean;
begin
  sorted:=false;
  while not sorted do begin
    sorted:=true;
    for i:=2 to n-1 do
      if det(a[1], a[i], a[i+1])<0
      then begin
        sw(a[i], a[i+1]);
        sorted:=false;
      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;
  qs;
  hull;
  afisHull;  
end.