Skip to content

Instantly share code, notes, and snippets.

@cy6erGn0m
Last active December 22, 2015 21:38
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save cy6erGn0m/6534249 to your computer and use it in GitHub Desktop.
Graham scan algorithm implementation in Haskell
import Data.List (sortBy, minimumBy, delete)
data Point = Point {x :: Double, y :: Double } deriving (Show, Eq)
add (Point ax ay) (Point bx by) = Point (ax + bx) (ay + by)
sub :: Point -> Point -> Point
sub (Point ax ay) (Point bx by) = Point (ax - bx) (ay - by)
mult :: Point -> Point -> Double
mult (Point ax ay) (Point bx by) = ax * by - ay * bx
angle3 :: Point -> Point -> Point -> Double
angle3 a b c = mult u v
where u = sub b a ;
v = sub c a
comparePointsBL (Point ax ay) (Point bx by)
| ay > by = GT
| ay < by = LT
| ay == by = compare ax bx
findBottomLeft :: [Point] -> (Point, [Point])
findBottomLeft pts = (min, others)
where min = minimumBy comparePointsBL pts;
others = delete min pts
angle (Point ax ay) = atan2 ay ax
distance (Point ax ay) = sqrt (ax * ax + ay * ay)
pointsPairsSort pairs = sortBy comparison pairs
where comparison (angleA, distanceA, _) (angleB, distanceB, _)
| angleA > angleB = GT
| angleA < angleB = LT
| True = compare distanceA distanceB
sortPoints :: Point -> [Point] -> [Point]
sortPoints offset pts = pointsUnPair offset (pointsPairsSort (pointsPairs offset pts))
where pointsUnPair base pairs = [ add base pt | (_, _, pt) <- pairs];
pointsPairs offset pts = [ (angle point, distance point, point) | point <- pts]
where pointsRelativeTo base pts = [ pointRelativeTo base x | x <- pts]
where pointRelativeTo base pt = sub pt base;
graham :: [Point] -> [Point]
graham points = if length points >= 3 then grahamImpl (tail sorted) [head sorted, min]
else []
where (min, rest) = findBottomLeft points;
sorted = sortPoints min rest
grahamImpl :: [Point] -> [Point] -> [Point]
grahamImpl [] (top:pretop:s) = (top:pretop:s)
grahamImpl [] ss = []
grahamImpl (p:ps) (top:pretop:s) =
if angle3 pretop top p <= 0 then
grahamImpl (p:ps) (pretop:s)
else
grahamImpl ps (p:top:pretop:s)
grahamImpl (p:ps) s = []
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment