cga/Algorithms/ConvexHull/GrahamScan.hs

163 lines
4.8 KiB
Haskell
Raw Normal View History

{-# OPTIONS_HADDOCK ignore-exports #-}
2014-10-10 15:40:08 +00:00
module Algorithms.ConvexHull.GrahamScan where
2014-10-10 15:40:08 +00:00
import Algebra.Vector
import Algebra.VectorTypes
import Diagrams.TwoD.Types
2014-10-10 15:40:08 +00:00
import MyPrelude
-- |Get all points on a convex hull by using the graham scan
-- algorithm.
{--
========== FUNCTIONAL PSEUDO CODE ======================
input: unsorted list us'
output: sorted convex hull list
variables:
(lowerHull, restl) = splitAt3IntoTuple (sort us')
(upperHull, restu) = reverse (splitAt3IntoTuple (sort us'))
main scope:
return (scanHalf upperHull restu) ++
(stripFirstAndLastElem(scanHalf lowerHull restl))
=== begin scanHalf function ===
scanHalf (min 3 elem => lowerHull) (min 1 elem => rest)
| isNotClockWise (last3Elements lowerHull) == True
= scanHalf (lowerHull + head rest) (tail rest)
| otherwise
= scanHalf (deleteSndToLastElem lowerHull + head rest)
(rest)
scanHalf (min 3 elem => lowerHull ) []
| isNotClockWise (last3Elements lowerHull) == True
= return lowerHull
| otherwise
= scanHalf (deleteSndToLastElem lowerHull) []
scanHalf lowerHull (min 1 elem => rest) = scanHalf (lowerHull + head rest)
(tail rest)
scanHalf lowerHull _ = lowerHull
=== end scanHalf function ===
============= SIMULATION ===================================
xs = [(100, 100), (200, 450), (250, 250)]
ys = [(300, 400), (400, 200)]
notcw (100, 100) (200, 450) (250, 250) => false, pop snd2last of xs
===
move first of ys to end of xs
xs = [(100, 100), (250, 250), (300, 400)]
ys = [(400, 200)]
notcw (100, 100), (250, 250) (300, 400) => true
===
move first of ys to end of xs
xs = [(100, 100), (250, 250), (300, 400), (400, 200)]
ys = []
notcw (250, 250) (300, 400) (400, 200) => false, pop snd2last of xs
===
xs = [(100, 100), (250, 250), (400, 200)]
ys = []
notcw (100, 100) (250, 250) (400, 200) => false, pop snd2last of xs
===
xs = [(100, 100), (400, 200)]
ys = []
===
return [(100, 100), (400, 200)]
=========================================================
--}
grahamCH :: [PT] -> [PT]
grahamCH vs = grahamUCH vs ++ (tailInit . grahamLCH $ vs)
-- |Get the lower part of the convex hull.
grahamLCH :: [PT] -> [PT]
grahamLCH vs = scanH lH lHRest
where
2014-10-12 00:11:47 +00:00
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
(lH, lHRest) = first reverse . splitAt 3 $ sortedXY
-- |Get the upper part of the convex hull.
grahamUCH :: [PT] -> [PT]
grahamUCH vs = scanH uH uHRest
where
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
(uH, uHRest) = first reverse . splitAt 3 . reverse $ sortedXY
-- |This scans only a half of the convex hull. If it's the upper
-- or lower half depends on the input.
-- Also, the first list is reversed since we only care about the last
-- 3 elements and want to stay efficient.
scanH :: [PT] -- ^ the first 3 starting points in reversed order
-> [PT] -- ^ the rest of the points
-> [PT] -- ^ all convex hull points for the half
scanH hs@(x:y:z:xs) (r':rs')
| notcw z y x = scanH (r':hs) rs'
| otherwise = scanH (x:z:xs) (r':rs')
scanH hs@(x:y:z:xs) []
| notcw z y x = hs
| otherwise = scanH (x:z:xs) []
scanH hs (r':rs') = scanH (r':hs) rs'
scanH hs _ = hs
2014-10-09 01:27:02 +00:00
-- |Compute all steps of the graham scan algorithm to allow
-- visualizing it.
-- Whether the upper or lower hull is computed depends on the input.
2014-10-13 17:50:02 +00:00
grahamCHSteps :: Int -> [PT] -> [PT] -> [[PT]]
grahamCHSteps c xs' ys'
| c >= 0 = scanH 0 xs' ys' : grahamCHSteps (c - 1) xs' ys'
| otherwise = []
where
scanH c' hs@(x:y:z:xs) (r':rs')
| c' >= c = hs
| notcw z y x = scanH (c' + 1) (r':hs) rs'
| otherwise = scanH (c' + 1) (x:z:xs) (r':rs')
scanH c' hs@(x:y:z:xs) []
| c' >= c = hs
| notcw z y x = hs
| otherwise = scanH (c' + 1) (x:z:xs) []
scanH c' hs (r':rs')
| c' >= c = hs
| otherwise = scanH (c' + 1) (r':hs) rs'
scanH _ xs _ = xs
2014-10-13 01:25:22 +00:00
-- |Get all iterations of the upper hull of the graham scan algorithm.
2014-10-13 17:50:02 +00:00
grahamUHSteps :: [PT] -> [[PT]]
grahamUHSteps vs =
2014-10-13 01:25:22 +00:00
(++) [getLastX 2 sortedXY] .
rmdups .
init .
reverse .
2014-10-13 17:50:02 +00:00
grahamCHSteps ((* 2) . length $ vs) uH $
uHRest
where
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
(uH, uHRest) = first reverse . splitAt 3 . reverse $ sortedXY
2014-10-13 01:25:22 +00:00
-- |Get all iterations of the lower hull of the graham scan algorithm.
2014-10-13 17:50:02 +00:00
grahamLHSteps :: [PT] -> [[PT]]
grahamLHSteps vs =
2014-10-13 01:25:22 +00:00
(++) [take 2 sortedXY] .
rmdups .
reverse .
2014-10-13 17:50:02 +00:00
grahamCHSteps ((* 2) . length $ vs) lH $
2014-10-13 01:25:22 +00:00
lHRest
where
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
(lH, lHRest) = first reverse . splitAt 3 $ sortedXY