Problem

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 O(nlog(n))$\mathcal{O}(n\mathrm{log}(n))$ time complexity. However, I am still not quite there yet when it comes to understanding Lazy Evaluation, so not sure if it is indeed O(nlog(n))$\mathcal{O}(n\mathrm{log}(n))$.

```
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.

- Is this Graham Scan Algorithm?
- Is it O(nlog(n))$\mathcal{O}(n\mathrm{log}(n))$?
- Is this elegant, readable Haskell code?

Solution

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)
```