# Graham Scan Implementation

Jump to navigation
Jump to search

Descriptions of this problem can be found in Real World Haskell, Chapter 3

```
import Data.Function (on, (&))
import Data.List (sortOn, tails)
import Data.Tuple (swap)
data Direction = TurnLeft | TurnRight | GoStraight
deriving (Show, Eq)
type Point2D = (Double, Double)
turning :: Point2D -> Point2D -> Point2D -> Direction
turning (x1, y1) (x2, y2) (x3, y3) = case compare area 0 of
LT -> TurnRight
EQ -> GoStraight
GT -> TurnLeft
where
area = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)
bottomLeft :: [Point2D] -> Point2D
bottomLeft = swap . foldr1 min . map swap
sortOnPolar :: [Point2D] -> [Point2D]
sortOnPolar [] = []
sortOnPolar ps = origin : sortOn polar rest
where
polar (x, y) = atan2 (y - y0) (x - x0)
origin@(x0, y0) = bottomLeft ps
rest = filter (/= origin) ps
grahamScan :: [Point2D] -> [Point2D]
grahamScan [] = []
grahamScan (p : ps) = grahamScan' [p] ps
where
grahamScan' xs [] = xs
grahamScan' xs [y] = y : xs
grahamScan' xs'@(x : xs) (y : z : ys)
| turning x y z == TurnLeft = grahamScan' (y : xs') (z : ys)
| otherwise = grahamScan' xs (x : z : ys)
convex :: [Point2D] -> [Point2D]
convex = grahamScan . sortOnPolar
```

## Test

```
import Control.Monad
import Convex (convex)
import Data.Function ((&))
import Data.List (sort)
import Test.QuickCheck
convexIsStable n =
forAll
(replicateM n arbitrary)
(\xs -> (xs & convex & sort) == (xs & convex & convex & sort))
main :: IO ()
main = do
putStrLn "Running tests..."
mapM checkN [0, 1, 2, 3, 4, 5, 10, 100, 1000]
putStrLn "done."
where
checkN :: Int -> IO ()
checkN n = do
putStrLn $ "size: " ++ show n
quickCheck (convexIsStable n)
```

The results are:

```
Running tests...
size: 0
+++ OK, passed 100 tests.
size: 1
+++ OK, passed 100 tests.
size: 2
+++ OK, passed 100 tests.
size: 3
+++ OK, passed 100 tests.
size: 4
+++ OK, passed 100 tests.
size: 5
+++ OK, passed 100 tests.
size: 10
+++ OK, passed 100 tests.
size: 100
+++ OK, passed 100 tests.
size: 1000
+++ OK, passed 100 tests.
done.
```