54 lines
1.8 KiB
Haskell
54 lines
1.8 KiB
Haskell
module ConvexHull where
|
|
|
|
import qualified Data.Set as S (fromList, toAscList)
|
|
import qualified Data.List as L (init, foldl')
|
|
|
|
data Point a = Point
|
|
{ xCoord :: a
|
|
, yCoord :: a
|
|
}
|
|
deriving(Eq, Ord)
|
|
|
|
data Vec a = Vec
|
|
{ xComp :: a
|
|
, yComp :: a
|
|
}
|
|
|
|
direction :: Num a => Point a -> Point a -> Vec a
|
|
direction (Point x1 y1) (Point x2 y2) = Vec (x2 - x1) (y2 - y1)
|
|
|
|
innerProd :: Num a => Vec a -> Vec a -> a
|
|
innerProd (Vec x1 y1) (Vec x2 y2) = x1*x2 + y1*y2
|
|
|
|
-- Check whether the three points make a convex angle
|
|
convexAngle :: (Ord a, Num a) => Point a -> Point a -> Point a -> Bool
|
|
convexAngle p1 p2 p3 = let dir1 = p1 `direction` p2
|
|
dir2 = p2 `direction` p3
|
|
in (dir1 `innerProd` dir2) > 0
|
|
|
|
|
|
removeNonConvexAngles :: (Ord a, Num a) => [Point a] -> [Point a]
|
|
removeNonConvexAngles ps@(p1:p2:p3:rest)
|
|
| convexAngle p3 p2 p1 = ps
|
|
| otherwise = removeNonConvexAngles (p1:p3:rest)
|
|
|
|
-- if there are less than three points, there is nothing to do
|
|
removeNonConvexAngles ps = ps
|
|
|
|
convexHullHelper :: (Ord a, Num a) => [Point a] -> Point a -> [Point a]
|
|
convexHullHelper ps newPoint = removeNonConvexAngles (newPoint : ps)
|
|
|
|
|
|
-- Given a set of points, return the list of points (ordered clockwisely)
|
|
-- that form the vertices of the convex hull
|
|
convexHull :: (Ord a, Num a) => [Point a] -> [Point a]
|
|
convexHull points =
|
|
let orderedPoints = S.toAscList (S.fromList points)
|
|
upperConvexHull = L.foldl' convexHullHelper [] orderedPoints
|
|
lowerConvexHull = foldr (flip convexHullHelper) [] orderedPoints
|
|
-- Remove first and last element from the lower convex hull, because they are duplicates
|
|
lowerConvexHull' = tail (L.init lowerConvexHull)
|
|
|
|
in upperConvexHull ++ lowerConvexHull'
|
|
|