Cod sursa(job #599707)

Utilizator Luncasu_VictorVictor Luncasu Luncasu_Victor Data 29 iunie 2011 14:37:10
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 3.04 kb
program _make_convex_envelope; const nmax = 100 * 100;
type	nod = record
		x ,y : double;
	end;
        sir = array[1..nmax] of nod;
var	s ,s_up ,s_down ,s_conv : sir;
	n ,n_up ,n_down ,n_conv : longword;

procedure _read;
var	f : text;
	i : longword;
begin
assign(f,'infasuratoare.in'); reset(f);
readln(f, n);
for i := 1 to n do readln(f, s[i].x ,s[i].y);
close(f);
end;

function sarrus(p1, p2 ,p3 : nod) : double;
begin
sarrus := p1.x * p2.y + p2.x * p3.y + p3.x * p1.y
	- p3.x * p2.y - p1.x * p3.y - p2.x * p1.y;
end;

procedure _swap(var p1 ,p2 : nod);
var	p3 : nod;
begin
p3 := p1; p1 := p2; p2 := p3;
end;

procedure _quick_sort(var s : sir; left ,right : longword);
var	i ,j : longword;
	piv : double;
begin
i := left; j := right; piv := s[(i + j) div 2].x;
while (i < j) do
begin
 while (s[i].x < piv) do inc(i);
 while (s[j].x > piv) do dec(j);
 if (i <= j) then
 begin
  _swap(s[i], s[j]);
  inc(i); dec(j);
 end;
end;
if (i < right) then _quick_sort(s ,i ,right);
if (j > left) then _quick_sort(s ,left, j);
end;

procedure _convex(var s : sir; var n : longword);
var     q : sir;
        i ,k : longword;
begin
fillchar(q, sizeof(q), 0);
q[1] := s[1];
q[2] := s[2];
k := 2;
for i := 3 to n do
begin
 inc(k); q[k] := s[i];
 while (k > 2) and (sarrus(q[k - 2], q[k - 1], q[k]) >= 0) do
 begin
  q[k - 1] := q[k];
  dec(k);
 end;
end;
s := q;
n := k;
end;

procedure _convexb(var s : sir; var n : longword);
var     q : sir;
        i ,k : longword;
begin
fillchar(q, sizeof(q), 0);
q[1] := s[1];
q[2] := s[2];
k := 2;
for i := 3 to n do
begin
 inc(k); q[k] := s[i];
 while (k > 2) and (sarrus(q[k - 2], q[k - 1], q[k]) <= 0) do
 begin
  q[k - 1] := q[k];
  dec(k);
 end;
end;
s := q;
n := k;
end;

procedure _convex_envelope;
var	i ,j ,xmin ,xmax: longword;
	pos : double;
        back : boolean;
begin
//1. gasim abcisa minima si maxima
xmin := 1; xmax := 1;
for i := 2 to n do
if s[i].x < s[xmin].x then xmin := i else
if s[i].x > s[xmax].x then xmax := i;
//2. separam in submultimi multimea punctelor s
s_up[1] := s[xmin]; n_up := 1;
s_down[1] := s[xmin]; n_down := 1;
for i := 1 to n do
begin
pos := sarrus(s[xmin] ,s[xmax] ,s[i]);
if pos > 0 then
begin
 inc(n_up);
 s_up[n_up] := s[i];
end else
if pos < 0 then
begin
 inc(n_down);
 s_down[n_down] := s[i];
end;
end;
inc(n_up); s_up[n_up] := s[xmax];
inc(n_down); s_down[n_down] := s[xmax];
//3. sortam submultimile dupa cresterea abcisei
_quick_sort(s_up ,2 ,n_up - 1);
_quick_sort(s_down ,2 ,n_down - 1);
//4. crearea infasuratorea convexa
_convex(s_up, n_up);
_convexb(s_down, n_down);
end;

procedure _write;
var	f : text;
        i : longword;
begin
assign(f,'infasuratoare.out'); rewrite(f);
_quick_sort(s_up, 2, n_up - 1);
_quick_sort(s_down, 2, n_down - 1);
writeln(f, n_up + n_down - 2);
for i := 1 to n_up do writeln(f, s_up[i].x:0:6,#32,s_up[i].y:0:6);
for i := n_down - 1 downto 2 do writeln(f, s_down[i].x:0:6,#32,s_down[i].y:0:6);
close(f);
end;

begin
_read;
_convex_envelope;
_write;
end.