325 lines
8.7 KiB
ObjectPascal
325 lines
8.7 KiB
ObjectPascal
{$mode ISO}
|
|
|
|
program convex_hull_task (output);
|
|
|
|
{ Convex hulls, by Andrew's monotone chain algorithm.
|
|
|
|
For a description of the algorithm, see
|
|
https://en.wikibooks.org/w/index.php?title=Algorithm_Implementation/Geometry/Convex_hull/Monotone_chain&stableid=40169 }
|
|
|
|
const max_points = 1000;
|
|
type points_range = 0 .. max_points - 1;
|
|
|
|
type point =
|
|
record
|
|
x, y : real
|
|
end;
|
|
type point_array = array [points_range] of point;
|
|
|
|
var ciura_gaps : array [1 .. 8] of integer;
|
|
|
|
var example_points : point_array;
|
|
var hull : point_array;
|
|
var hull_size : integer;
|
|
var index : integer;
|
|
|
|
function make_point (x, y : real) : point;
|
|
begin
|
|
make_point.x := x;
|
|
make_point.y := y;
|
|
end;
|
|
|
|
{ The cross product as a signed scalar. }
|
|
function cross (u, v : point) : real;
|
|
begin
|
|
cross := (u.x * v.y) - (u.y * v.x)
|
|
end;
|
|
|
|
function point_subtract (u, v : point) : point;
|
|
begin
|
|
point_subtract := make_point (u.x - v.x, u.y - v.y)
|
|
end;
|
|
|
|
function point_equal (u, v : point) : boolean;
|
|
begin
|
|
point_equal := (u.x = v.x) and (u.y = v.y)
|
|
end;
|
|
|
|
procedure sort_points (num_points : integer;
|
|
var points : point_array);
|
|
{ Sort first in ascending order by x-coordinates, then in
|
|
ascending order by y-coordinates. Any decent sort algorithm will
|
|
suffice; for the sake of interest, here is the Shell sort of
|
|
https://en.wikipedia.org/w/index.php?title=Shellsort&oldid=1084744510 }
|
|
var
|
|
i, j, k, gap, offset : integer;
|
|
temp : point;
|
|
done : boolean;
|
|
begin
|
|
for k := 1 to 8 do
|
|
begin
|
|
gap := ciura_gaps[k];
|
|
for offset := 0 to gap - 1 do
|
|
begin
|
|
i := offset;
|
|
while i <= num_points - 1 do
|
|
begin
|
|
temp := points[i];
|
|
j := i;
|
|
done := false;
|
|
while not done do
|
|
begin
|
|
if j < gap then
|
|
done := true
|
|
else if points[j - gap].x < temp.x then
|
|
done := true
|
|
else if ((points[j - gap].x = temp.x)
|
|
and (points[j - gap].y < temp.y)) then
|
|
done := true
|
|
else
|
|
begin
|
|
points[j] := points[j - gap];
|
|
j := j - gap
|
|
end
|
|
end;
|
|
points[j] := temp;
|
|
i := i + gap
|
|
end
|
|
end
|
|
end
|
|
end; { sort_points }
|
|
|
|
procedure delete_neighbor_duplicates (var n : integer;
|
|
var pt : point_array);
|
|
|
|
procedure delete_trailing_duplicates;
|
|
var
|
|
i : integer;
|
|
done : boolean;
|
|
begin
|
|
i := n - 1;
|
|
done := false;
|
|
while not done do
|
|
begin
|
|
if i = 0 then
|
|
begin
|
|
n := 1;
|
|
done := true
|
|
end
|
|
else if not point_equal (pt[i - 1], pt[i]) then
|
|
begin
|
|
n := i + 1;
|
|
done := true
|
|
end
|
|
else
|
|
i := i + 1
|
|
end
|
|
end;
|
|
|
|
procedure delete_nontrailing_duplicates;
|
|
var
|
|
i, j, num_deleted : integer;
|
|
done : boolean;
|
|
begin
|
|
i := 0;
|
|
while i < n - 1 do
|
|
begin
|
|
j := i + 1;
|
|
done := false;
|
|
while not done do
|
|
begin
|
|
if j = n then
|
|
done := true
|
|
else if not point_equal (pt[j], pt[i]) then
|
|
done := true
|
|
else
|
|
j := j + 1
|
|
end;
|
|
if j <> i + 1 then
|
|
begin
|
|
num_deleted := j - i - 1;
|
|
while j <> n do
|
|
begin
|
|
pt[j - num_deleted] := pt[j];
|
|
j := j + 1
|
|
end;
|
|
n := n - num_deleted
|
|
end;
|
|
i := i + 1
|
|
end
|
|
end;
|
|
|
|
begin
|
|
delete_trailing_duplicates;
|
|
delete_nontrailing_duplicates
|
|
end; { delete_neighbor_duplicates }
|
|
|
|
procedure construct_lower_hull (n : integer;
|
|
pt : point_array;
|
|
var hull_size : integer;
|
|
var hull : point_array);
|
|
var
|
|
i, j : integer;
|
|
done : boolean;
|
|
begin
|
|
j := 1;
|
|
hull[0] := pt[0];
|
|
hull[1] := pt[1];
|
|
for i := 2 to n - 1 do
|
|
begin
|
|
done := false;
|
|
while not done do
|
|
begin
|
|
if j = 0 then
|
|
begin
|
|
j := j + 1;
|
|
hull[j] := pt[i];
|
|
done := true
|
|
end
|
|
else if 0.0 < cross (point_subtract (hull[j],
|
|
hull[j - 1]),
|
|
point_subtract (pt[i],
|
|
hull[j - 1])) then
|
|
begin
|
|
j := j + 1;
|
|
hull[j] := pt[i];
|
|
done := true
|
|
end
|
|
else
|
|
j := j - 1
|
|
end
|
|
end;
|
|
hull_size := j + 1
|
|
end; { construct_lower_hull }
|
|
|
|
procedure construct_upper_hull (n : integer;
|
|
pt : point_array;
|
|
var hull_size : integer;
|
|
var hull : point_array);
|
|
var
|
|
i, j : integer;
|
|
done : boolean;
|
|
begin
|
|
j := 1;
|
|
hull[0] := pt[n - 1];
|
|
hull[1] := pt[n - 2];
|
|
for i := n - 3 downto 0 do
|
|
begin
|
|
done := false;
|
|
while not done do
|
|
begin
|
|
if j = 0 then
|
|
begin
|
|
j := j + 1;
|
|
hull[j] := pt[i];
|
|
done := true
|
|
end
|
|
else if 0.0 < cross (point_subtract (hull[j],
|
|
hull[j - 1]),
|
|
point_subtract (pt[i],
|
|
hull[j - 1])) then
|
|
begin
|
|
j := j + 1;
|
|
hull[j] := pt[i];
|
|
done := true
|
|
end
|
|
else
|
|
j := j - 1
|
|
end
|
|
end;
|
|
hull_size := j + 1
|
|
end; { construct_upper_hull }
|
|
|
|
procedure contruct_hull (n : integer;
|
|
pt : point_array;
|
|
var hull_size : integer;
|
|
var hull : point_array);
|
|
var
|
|
i : integer;
|
|
lower_hull_size, upper_hull_size : integer;
|
|
lower_hull, upper_hull : point_array;
|
|
begin
|
|
{ A side note: the calls to construct_lower_hull and
|
|
construct_upper_hull could be done in parallel. }
|
|
construct_lower_hull (n, pt, lower_hull_size, lower_hull);
|
|
construct_upper_hull (n, pt, upper_hull_size, upper_hull);
|
|
|
|
hull_size := lower_hull_size + upper_hull_size - 2;
|
|
|
|
for i := 0 to lower_hull_size - 2 do
|
|
hull[i] := lower_hull[i];
|
|
for i := 0 to upper_hull_size - 2 do
|
|
hull[lower_hull_size - 1 + i] := upper_hull[i]
|
|
end; { contruct_hull }
|
|
|
|
procedure find_convex_hull (n : integer;
|
|
points : point_array;
|
|
var hull_size : integer;
|
|
var hull : point_array);
|
|
var
|
|
pt : point_array;
|
|
numpt : integer;
|
|
i : integer;
|
|
begin
|
|
for i := 0 to n - 1 do
|
|
pt[i] := points[i];
|
|
numpt := n;
|
|
|
|
sort_points (numpt, pt);
|
|
delete_neighbor_duplicates (numpt, pt);
|
|
|
|
if numpt = 0 then
|
|
hull_size := 0
|
|
else if numpt <= 2 then
|
|
begin
|
|
hull_size := numpt;
|
|
for i := 0 to numpt - 1 do
|
|
hull[i] := pt[i]
|
|
end
|
|
else
|
|
contruct_hull (numpt, pt, hull_size, hull)
|
|
end; { find_convex_hull }
|
|
|
|
begin
|
|
ciura_gaps[1] := 701;
|
|
ciura_gaps[2] := 301;
|
|
ciura_gaps[3] := 132;
|
|
ciura_gaps[4] := 57;
|
|
ciura_gaps[5] := 23;
|
|
ciura_gaps[6] := 10;
|
|
ciura_gaps[7] := 4;
|
|
ciura_gaps[8] := 1;
|
|
|
|
example_points[0] := make_point (16, 3);
|
|
example_points[1] := make_point (12, 17);
|
|
example_points[2] := make_point (0, 6);
|
|
example_points[3] := make_point (-4, -6);
|
|
example_points[4] := make_point (16, 6);
|
|
example_points[5] := make_point (16, -7);
|
|
example_points[6] := make_point (16, -3);
|
|
example_points[7] := make_point (17, -4);
|
|
example_points[8] := make_point (5, 19);
|
|
example_points[9] := make_point (19, -8);
|
|
example_points[10] := make_point (3, 16);
|
|
example_points[11] := make_point (12, 13);
|
|
example_points[12] := make_point (3, -4);
|
|
example_points[13] := make_point (17, 5);
|
|
example_points[14] := make_point (-3, 15);
|
|
example_points[15] := make_point (-3, -9);
|
|
example_points[16] := make_point (0, 11);
|
|
example_points[17] := make_point (-9, -3);
|
|
example_points[18] := make_point (-4, -2);
|
|
example_points[19] := make_point (12, 10);
|
|
|
|
find_convex_hull (19, example_points, hull_size, hull);
|
|
|
|
for index := 0 to hull_size - 1 do
|
|
writeln (hull[index].x, ' ', hull[index].y)
|
|
end.
|
|
|
|
{--------------------------------------------------------------------}
|
|
{ The Emacs Pascal mode is intolerable.
|
|
Until I can find a substitute: }
|
|
{ local variables: }
|
|
{ mode: fundamental }
|
|
{ end: }
|