Graham scan algorithm implementation in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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