Direction.hs

-- file: Direction.hs

module Direction where

data Direction = LeftTurn | RightTurn | Straight
                 deriving (Show, Eq)

type Point = (Double, Double)
type Vector = (Double, Double)

point :: Double -> Double -> Point
point x y = (x, y)

vector :: Point -> Point -> Vector
vector (x0, y0) (x1, y1) = (x1 - x0, y1 - y0)

crossProduct :: Vector -> Vector -> Double
crossProduct (vx, vy) (wx, wy) = wy * vx - wx * vy

direction :: Point -> Point -> Point -> Direction
direction p q r
    | crossProduct v w > 0 = LeftTurn
    | crossProduct v w < 0 = RightTurn
    | otherwise            = Straight
        where v = vector p q
              w = vector p r

GrahamScan.hs

-- file: GrahamScan.hs

import Direction
import Data.List (sortBy)


lowestOf :: [Point] -> Point
lowestOf (p @ (px, py) : q @ (qx, qy) : ps)
    | py < qy   = lowestOf (p : ps)
    | qy < py   = lowestOf (q : ps)
    | px < qx   = lowestOf (p : ps)
    | otherwise = lowestOf (q : ps) 
lowestOf p = head p

angle :: Point -> Double
angle (0, 0) = 1 / 0
angle (x, y) = x / radius
    where radius = sqrt (x ^^ 2 + y ^^ 2)

pointsCompare :: Point -> Point -> Ordering
pointsCompare p q = compare (angle q) (angle p)
    
translate :: Point -> [Point] -> [Point]
translate (px, py) ps = map (\(x, y) -> (x - px, y - py)) ps 

sortPoints :: [Point] -> [Point]
sortPoints ps = translate np $ sortBy pointsCompare $ translate p ps
    where p  = lowestOf ps
          np = (- fst p, - snd p)

scan :: [Point] -> [Point] -> [Point]
scan (p : q : r : ps) hull
    | direction p q r == RightTurn = scan (p : r : ps) hull
    | otherwise                    = scan (q : r : ps) (hull ++ [p])
scan ps hull = hull ++ ps

grahamScan :: [Point] -> [Point]
grahamScan ps = scan (sortPoints ps) []

points = [point 1 1, point (-1) 1, point (-1) (-1), point 1 (-1), point 0 0, point (-2) 5, point (-1) 3]