Graham Scan Haskell Exercise

graham.hs

import Data.List
import Debug.Trace

data Point     = Point Double Double
                 deriving(Show, Eq) 
data Direction = DirectionLeft | DirectionRight | DirectionStraight
                 deriving(Show, Eq) 
data Vector    = Vector Double Double
                 deriving(Show)

vectorFromPoints :: Point -> Point -> Vector
vectorFromPoints (Point x1 y1) (Point x2 y2) = Vector (x2 - x1) (y2 - y1)

direction :: Vector -> Vector -> Direction
direction (Vector ax ay) (Vector bx by) 
    | a > 0  = DirectionLeft
    | a == 0 = DirectionStraight
    | a < 0  = DirectionRight
    where a = ax * by - ay * bx

directionFromPoints :: Point -> Point -> Point -> Direction
directionFromPoints a b c = direction ab bc
    where ab = vectorFromPoints a b
          bc = vectorFromPoints b c

orderByAngle :: [Point] -> [Point]
orderByAngle points = first : sortBy angleOrder rest
    where 
        angleOrder p1 p2 
            | (a1 == a2) = compare (dist first p1) (dist first p2)
            | otherwise  = compare a2 a1
            where 
                a1 = angle p1
                a2 = angle p2
                dist (Point x1 y1) (Point x2 y2) = (x1 - x2) ^ 2 + (y1 - y2) ^ 2
                angle p = vectorAngle (vectorFromPoints first p)
                    where vectorAngle (Vector x y) = x / sqrt(x * x + y * y)
        first = minimumBy leftLower points
            where leftLower (Point x1 y1) (Point x2 y2) 
                      | (y1 == y2) = compare x1 x2
                      | otherwise  = compare y1 y2
        rest = delete first points  

            
clean :: [Point] -> [Point] -> [Point]
clean (last : []) as = (last : as)
clean (c1 : c2 : cs) (a : as)
    | directionFromPoints a c1 c2 == DirectionLeft = clean (c2 : cs) (c1 : a : as)
    | otherwise = clean (a : c2 : cs) as

convexHull :: [Point] -> [Point]
convexHull points = clean considered accepted
    where ordered     = orderByAngle points
          considered  = drop 2 ordered
          accepted    = reverse (take 2 ordered)