ALGO: Split scanH out and make the graham API more modular

This commit is contained in:
hasufell 2014-10-13 19:49:53 +02:00
parent 67ef9fa223
commit 7cdb867cf4
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 37 additions and 24 deletions

View File

@ -76,28 +76,41 @@ ys = []
return [(100, 100), (400, 200)]
=========================================================
--}
grahamGetCH :: [PT] -> [PT]
grahamGetCH vs =
scanH uH uHRest ++ tailInit (scanH lH lHRest)
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
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
-- |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
-- |Compute all steps of the graham scan algorithm to allow

View File

@ -52,7 +52,7 @@ convexHullPoints = Diag chp
(repeat dot))
where
dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
vtch = grahamGetCH vt
vtch = grahamCH vt
-- |Show coordinates as text above the convex hull points.
@ -64,7 +64,7 @@ convexHullPointsText = Diag chpt
zip vtchf
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
where
vtchf = grahamGetCH . filter (inRange (dX p) (dY p)) $ vt
vtchf = grahamCH . filter (inRange (dX p) (dY p)) $ vt
-- |Create a diagram which shows the lines along the convex hull
@ -76,10 +76,10 @@ convexHullLines = Diag chl
chl p vt =
(strokeTrail .
fromVertices .
flip (++) [head $ grahamGetCH vtf] .
grahamGetCH $
vtf) #
moveTo (head $ grahamGetCH vtf) #
flip (++) [head $ grahamCH vtf] .
grahamCH $
vtf) #
moveTo (head $ grahamCH vtf) #
lc red
where
vtf = filter (inRange (dX p) (dY p)) vt