Is this Graham Scan Algorithm? Is it O(n log n)?
Yes, it is.
Is this elegant, readable Haskell code?
No. It's buggy and far from elegant. Let's start with the bugs in convex_hull_find
:
convex_hull_find [] = []
convex_hull_find (x:[]) = x:[]
Bug 1: convex_hull_find (x:x1:[]) = x:x1:[]
Bug 2: convex_hull_find (x:x1:x2:[]) = x:x1:x2:[]
convex_hull_find a = (find_half_hull (tail sorted_x) [head sorted_x]) ++ (find_half_hull (tail (reverse sorted_x)) [head (reverse sorted_x)])
Bug 3: where sorted_x = sortBy predicate a
predicate (x, y) (x1, y1) = compare x x1
find_half_hull ([]) hull = ...
The first bug is simple and obvious: for non-unique inputs like [(0,0),(0,0)]
, the convex hull should be [(0,0)]
, but the input is returned verbatim. Non-unique inputs of arbitrary length are also handled improperly. The second bug arises from reordering inputs of length three. Obviously, [p1, p2, p3]
(counterclockwise triangle), [p3, p2, p1]
(clockwise) and [p2, p3, p1]
(different starting point) should all result in the exact same convex hull, namely the counterclockwise triangle [p1, p2, p3]
that starts with the lowest-sorting point.
To fix the first bug, just ensure the input is sorted and unique before you do any processing, even in case of short-circuit evaluation. The second bug can be fixed by removing the special case for inputs of length three, there is no need for it anyway. Also, replace head
and tail
by last
and init
so the lowest-sorting point stays in the first position for arbitrary-length inputs.
The third bug is a bit more tricky: if two points have the same x
-coordinate, sorting by x
is insufficient to find the starting point. You need to brake ties by y
. Luckily, that's how Haskell orders tuples by default, so just replace sortBy predicate a
by sort a
. The input [(1,1),(1,0),(2,0),(1,2),(0,0)]
triggers the faulty behavior.
Below is a corrected version of the function, complete with type annotations and a docstring. I renamed find_half_hull
to grahamScan
and made it a first-order citizen to improve readability. Note that function names in Haskell are camelCase
by convention, not snake_case
.
convexHull :: (Num a, Ord a) => [(a,a)] -> [(a,a)]
-- ^ Convex hull in two dimensions.
convexHull points
| length sorted <= 2 = sorted
| otherwise = init (grahamScan sorted) ++ init (grahamScan $ reverse sorted)
where sorted = map head $ group $ sort points
In addition to renaming find_half_hull
to grahamScan
, I split it in two separate, simple functions and slapped a docstring to each. They are defined as follows:
grahamScan :: (Num a, Ord a) => [(a,a)] -> [(a,a)]
-- ^ Performs a Graham scan on an ordered list of unique points.
grahamScan = foldr push []
where push point stack = grahamEliminate (point:stack)
The first of those, grahamScan
, simply pushes points onto a stack one by one (starting with the last) and calls grahamEliminate
on each iteration. The latter tests if the top three point form a counterclockwise triangle and removes points as appropriate.
grahamEliminate :: (Num a, Ord a) => [(a,a)] -> [(a,a)]
-- ^ Pops second-to-top element from a stack if top three elements do
-- not form a counterclockwise triangle. Repeats if necessary.
grahamEliminate (p1:p2:p3:stack)
| doubleArea p1 p2 p3 <= 0 = grahamEliminate (p1:p3:stack)
grahamEliminate stack = stack
Finally, the following code can be replaced by a one-liner. Just leave it to the caller to test the sign, it's easier than to test for your custom type.
data Direction = LeftTurn | RightTurn | Straight deriving (Show, Eq)
findDirBetter (x, y) (x1, y1) (x2, y2)
| cros_product == 0 = Straight
| cros_product > 0 = LeftTurn
| cros_product < 0 = RightTurn
where cros_product = (x1 - x) * (y2 - y1) - (y1 - y) * (x2 - x1)
The complete code is then:
import Data.List
convexHull :: (Num a, Ord a) => [(a,a)] -> [(a,a)]
-- ^ Convex hull in two dimensions.
convexHull points
| length sorted <= 2 = sorted
| otherwise = init (grahamScan sorted) ++ init (grahamScan $ reverse sorted)
where sorted = map head $ group $ sort points
grahamScan :: (Num a, Ord a) => [(a,a)] -> [(a,a)]
-- ^ Performs a Graham scan on an ordered list of unique points.
grahamScan = foldr push []
where push point stack = grahamEliminate (point:stack)
grahamEliminate :: (Num a, Ord a) => [(a,a)] -> [(a,a)]
-- ^ Pops second-to-top element from a stack if top three elements do
-- not form a counterclockwise triangle. Repeats if necessary.
grahamEliminate (p1:p2:p3:stack)
| doubleArea p1 p2 p3 <= 0 = grahamEliminate (p1:p3:stack)
grahamEliminate stack = stack
doubleArea :: Num a => (a,a) -> (a,a) -> (a,a) -> a
-- ^ Twice the area of a counterclockwise triangle. Negative if clockwise.
doubleArea (x1,y1) (x2,y2) (x3,y3) = (x2-x1) * (y3-y1) - (y2-y1) * (x3-x1)