2
\$\begingroup\$

I have just begun learning functional programming and Haskell.

This is my attempt to implement a solution to Graham Scan Algorithm in Haskell. Note that I am not even sure if this is indeed Graham Scan Algorithm, since I implemented this solution with only a few hints of the actual Graham Scan Algorithm. But I believe it to be correct and to have a \$\mathcal O\left(n \log(n)\right)\$ time complexity. However, I am still not quite there yet when it comes to understanding Lazy Evaluation, so not sure if it is indeed \$\mathcal O\left(n \log(n)\right)\$.

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)  

convex_hull_find []           = []
convex_hull_find (x:[])       = x:[]
convex_hull_find (x:x1:[])    = x:x1:[]
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)])
        where sorted_x                    = sortBy predicate a
              predicate (x, y) (x1, y1)   = compare x x1   
              find_half_hull ([]) hull    = tail hull
              find_half_hull l (x:[])     = find_half_hull (tail l) ((head l):x:[])
              find_half_hull l hull       = if findDirBetter (head (tail hull)) (head hull) (head l) /= RightTurn
                                            then find_half_hull (tail l) ((head l):hull)
                                            else find_half_hull l (tail hull)

Please critique everything from the algorithm to the code.

  1. Is this Graham Scan Algorithm?
  2. Is it \$\mathcal O\left(n \log(n)\right)\$?
  3. Is this elegant, readable Haskell code?
\$\endgroup\$
  • \$\begingroup\$ Welcome to Code Review. Please keep in mind that we expect your code to work as you intended. \$\endgroup\$ – Zeta Oct 22 '18 at 9:34
3
\$\begingroup\$

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)
\$\endgroup\$
  • 1
    \$\begingroup\$ Huh. You don't see post-documentation very often. Most code (especially in the standard library) uses pre-documentation, i.e. -- |, in order to keep function signature close to the body. But that's a matter of preference, I guess. Either way: your last doc string uses -- | instead of -- ^. \$\endgroup\$ – Zeta Oct 23 '18 at 5:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.