Convex hull: Difference between revisions

4,962 bytes added ,  2 years ago
Line 2,439:
{{out}}
<pre>Convex Hull: [(-9, -3), (-3, 15), (5, 19), (12, 17), (17, 5), (19, -8), (-3, -9)]</pre>
 
=={{header|Icon}}==
{{trans|ObjectIcon}}
 
 
<lang icon>#
# 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
#
 
record PlanePoint (x, y)
 
######################################################################
#
# Merge sort adapted from the Object Icon IPL (public domain code).
#
 
# A merge sort implementation. Unlike `qsort`, this returns a sorted
# copy, leaving the original unchanged. If pos1 and pos2 are given,
# then only the sublist l[pos1:pos2] is sorted, and that sublist is
# returned.
#
# :Parameters :
# : `l` - the list to sort
# : `cmp` - a comparator function
# : `pos1` - the first slice index, default 1
# : `pos2` - the second slice index, default 0
#
procedure mergesort (l, cmp)
return mergesort1 (l, cmp, 1, *l)
end
 
procedure mergesort1 (l, cmp, first, last)
local l1, l2, l3, m, v1
if last <= first then
return l[first:last + 1]
m := (first + last) / 2
l1 := mergesort1 (l, cmp, first, m)
l2 := mergesort1 (l, cmp, m + 1, last)
l3 := []
every v1 := !l1 do {
while cmp (v1, l2[1]) > 0 do
put (l3, get(l2))
put (l3, v1)
}
every put(l3, !l2)
return l3
end
 
######################################################################
 
procedure point_equals (p, q)
if p.x = q.x & p.y = q.y then return else fail
end
 
# Impose a total order on points, making it one that will work for
# Andrew's monotone chain algorithm. *)
procedure point_comes_before (p, q)
if (p.x < q.x) | (p.x = q.x & p.y < q.y) then return else fail
end
 
# Subtraction is really a vector or multivector operation.
procedure point_subtract (p, q)
return PlanePoint (p.x - q.x, p.y - q.y)
end
 
# Cross product is really a multivector operation.
procedure point_cross (p, q)
return (p.x * q.y) - (p.y * q.x)
end
 
procedure point_to_string (p)
return "(" || string (p.x) || " " || string (p.y) || ")"
end
 
######################################################################
 
# Comparison like C's strcmp(3).
procedure compare_points (p, q)
local cmp
 
if point_comes_before (p, q) then
cmp := -1
else if point_comes_before (q, p) then
cmp := 1
else
cmp := 0
return cmp
end
 
procedure sort_points (points)
# Non-destructive sort.
return mergesort (points, compare_points)
end
 
procedure delete_neighbor_dups (arr, equals)
local arr1, i
 
if *arr = 0 then {
arr1 := []
} else {
arr1 := [arr[1]]
i := 2
while i <= *arr do {
if not (equals (arr[i], arr1[-1])) then
put (arr1, arr[i])
i +:= 1
}
}
return arr1
end
 
procedure construct_lower_hull (pt)
local hull, i, j
 
hull := list (*pt)
hull[1] := pt[1]
hull[2] := pt[2]
j := 2
every i := 3 to *pt do {
while (j ~= 1 &
point_cross (point_subtract (hull[j], hull[j - 1]),
point_subtract (pt[i], hull[j - 1])) <= 0) do j -:= 1
j +:= 1
hull[j] := pt[i]
}
return hull[1 : j + 1]
end
 
procedure construct_upper_hull (pt)
local hull, i, j
 
hull := list (*pt)
hull[1] := pt[-1]
hull[2] := pt[-2]
j := 2
every i := 3 to *pt do {
while (j ~= 1 &
point_cross (point_subtract (hull[j], hull[j - 1]),
point_subtract (pt[-i], hull[j - 1])) <= 0) do j -:= 1
j +:= 1
hull[j] := pt[-i]
}
return hull[1 : j + 1]
end
 
procedure construct_hull (pt)
local lower_hull, upper_hull
 
lower_hull := construct_lower_hull (pt)
upper_hull := construct_upper_hull (pt)
return lower_hull[1 : -1] ||| upper_hull [1 : -1]
end
 
procedure find_convex_hull (points)
local pt, hull
 
if *points = 0 then {
hull := []
} else {
pt := delete_neighbor_dups (sort_points (points), point_equals)
if *pt <= 2 then {
hull := pt
} else {
hull := construct_hull (pt)
}
}
return hull
end
 
procedure main ()
local example_points, hull
 
example_points :=
[PlanePoint (16.0, 3.0),
PlanePoint (12.0, 17.0),
PlanePoint (0.0, 6.0),
PlanePoint (-4.0, -6.0),
PlanePoint (16.0, 6.0),
PlanePoint (16.0, -7.0),
PlanePoint (16.0, -3.0),
PlanePoint (17.0, -4.0),
PlanePoint (5.0, 19.0),
PlanePoint (19.0, -8.0),
PlanePoint (3.0, 16.0),
PlanePoint (12.0, 13.0),
PlanePoint (3.0, -4.0),
PlanePoint (17.0, 5.0),
PlanePoint (-3.0, 15.0),
PlanePoint (-3.0, -9.0),
PlanePoint (0.0, 11.0),
PlanePoint (-9.0, -3.0),
PlanePoint (-4.0, -2.0),
PlanePoint (12.0, 10.0)]
 
hull := find_convex_hull (example_points)
 
every write (point_to_string (!hull))
end
 
######################################################################</lang>
 
{{out}}
<pre>$ icon convex_hull_task-Icon.icn
(-9.0 -3.0)
(-3.0 -9.0)
(19.0 -8.0)
(17.0 5.0)
(12.0 17.0)
(5.0 19.0)
(-3.0 15.0)</pre>
 
=={{header|J}}==
1,448

edits