Convex hull: Difference between revisions
→{{header|Perl}}
Line 3,481:
<pre>$ ocaml convex_hull_task.ml
(-9. -3.) (-3. -9.) (19. -8.) (17. 5.) (12. 17.) (5. 19.) (-3. 15.)</pre>
=={{header|Pascal}}==
{{trans|Fortran}}
<lang pascal>{$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: }</lang>
{{out}}
<pre>$ fpc convex_hull_task.pas && ./convex_hull_task
Free Pascal Compiler version 3.2.2 [2021/06/27] for x86_64
Copyright (c) 1993-2021 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling convex_hull_task.pas
Linking convex_hull_task
324 lines compiled, 0.1 sec
-9.0000000000000000e+000 -3.0000000000000000e+000
-3.0000000000000000e+000 -9.0000000000000000e+000
1.9000000000000000e+001 -8.0000000000000000e+000
1.7000000000000000e+001 5.0000000000000000e+000
1.2000000000000000e+001 1.7000000000000000e+001
5.0000000000000000e+000 1.9000000000000000e+001
-3.0000000000000000e+000 1.5000000000000000e+001</pre>
=={{header|Perl}}==
| |||