geometry/ConvexHull.hs

33 lines
1.3 KiB
Haskell

module ConvexHull where
import Data.List (foldl', sort)
import Queries
addNewPoint :: (Ord a, Num a) => [Point a] -> Point a -> [Point a]
addNewPoint (p2:p1:rest) p = if (makesRightTurn p1 p2 p)
then p : p2 : p1 : rest
else addNewPoint (p1 : rest) p
addNewPoint ps p = p:ps
convexHull :: (Ord a, Show a, Num a) => [Point a] -> [Point a]
convexHull [] = []
convexHull points =
let sortedPoints = sort points
upperHull = foldl' addNewPoint [] sortedPoints
lowerHull = foldr (flip addNewPoint) [] sortedPoints
-- Remove initial point from upperHull because it is the last point of lowerHull
-- Remove initial point from lowerHull because it is the last point of upperHull
in tail upperHull ++ tail lowerHull
convexHull' :: (Ord a, Show a, Num a) => [Point a] -> [Point a]
convexHull' [] = []
convexHull' points =
let sortedPoints = sort points
upperHull = foldl' addNewPoint [] sortedPoints
lowerHull = foldl' (addNewPoint) [] (reverse sortedPoints)
-- Remove initial point from upperHull because it is the last point of lowerHull
-- Remove initial point from lowerHull because it is the last point of upperHull
in tail upperHull ++ tail lowerHull