Graham Scan Implementation

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.