Skip to content

Instantly share code, notes, and snippets.

# dminuoso/graham.hs Created Dec 19, 2017

 module Graham where import Data.List (sortBy) import Data.Ord (comparing) import Data.Monoid data Direction = Left' | Right' | Straight' deriving (Show) data Point a = Point { getX :: a , getY :: a } instance (Num a, Show a) => Show (Point a) where showsPrec d (Point a b) = showParen (d > 9) \$ showString "Point " . shows a . showString " " . shows b -- |Vector subtraction sub :: (Num a) => Point a -> Point a -> Point a sub (Point x1 y1) (Point x2 y2) = Point (x1 - x2) (y1 - y2) -- |Inner vector product dot :: (Num a) => Point a -> Point a -> a dot (Point x y) (Point x' y') = x * x' + y * y' -- |Length of a vector len :: (Floating a) => Point a -> a len (Point x y) = sqrt (x ^ 2 + y ^ 2) -- |Determinant of the matrix given by two R2 vectors det :: (Floating a) => Point a -> Point a -> a det (Point x y) (Point x' y') = x * y' - y * x' -- |Unoriented angle between two vectors angle :: (Floating a) => Point a -> Point a -> a angle p1 p2 = acos (p1 `dot` p2 / (len p1 * len p2)) toDeg :: (Floating a) => a -> a toDeg x = x * (180 / pi) -- |Oriented angle between two vectors orientedAngle :: (Floating a) => Point a -> Point a -> a orientedAngle p1 p2 = signum (det p1 p2) * p1 `angle` p2 uncurry3 :: (a -> b -> c -> d) -> (a,b,c) -> d uncurry3 f (a,b,c) = f a b c starting :: (Ord a) => Point a -> Point a -> Ordering starting (Point x1 y1) (Point x2 y2) = compare x1 x2 <> compare y1 y2 grahamScan :: (Ord a, Num a, Floating a) => [Point a] -> [Point a] grahamScan l = grahamScan' [pt, p] pts where (p:ps) = sortBy starting l (pt:pts) = sortBy (comparing \$ orientedAngle p) ps grahamScan' :: (Eq a, Floating a) => [Point a] -> [Point a] -> [Point a] grahamScan' stack@[pt1, pt2] (y:ys) = grahamScan' (y:stack) ys grahamScan' stack [] = stack grahamScan' stack@(pt1:pt2:pts) r@(y:ys) = case dirChange pt2 pt1 y of Right' -> grahamScan' (pt2:pts) r _ -> grahamScan' (y:stack) ys -- |Given three points, calculate the direction change dirChange :: (Eq a, Floating a) => Point a -> Point a -> Point a -> Direction dirChange p1 p2 p3 = case signum \$ det (p2 `sub` p1) (p3 `sub` p2) of 0 -> Straight' 1 -> Left' (-1) -> Right' -- |Create a sliding window of size 3 in a list windows3 :: [a] -> [(a,a,a)] windows3 l = zip3 l (drop 1 l) (drop 2 l) -- | Given a list of points, calculate the consecutive direction changes directions :: (Eq a, Floating a) => [Point a] -> [Direction] directions = fmap (uncurry3 dirChange) . windows3
to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.