ALGO: Split scanH out and make the graham API more modular
This commit is contained in:
parent
67ef9fa223
commit
7cdb867cf4
@ -76,28 +76,41 @@ ys = []
|
|||||||
return [(100, 100), (400, 200)]
|
return [(100, 100), (400, 200)]
|
||||||
=========================================================
|
=========================================================
|
||||||
--}
|
--}
|
||||||
grahamGetCH :: [PT] -> [PT]
|
grahamCH :: [PT] -> [PT]
|
||||||
grahamGetCH vs =
|
grahamCH vs = grahamUCH vs ++ (tailInit . grahamLCH $ vs)
|
||||||
scanH uH uHRest ++ tailInit (scanH lH lHRest)
|
|
||||||
|
|
||||||
|
-- |Get the lower part of the convex hull.
|
||||||
|
grahamLCH :: [PT] -> [PT]
|
||||||
|
grahamLCH vs = scanH lH lHRest
|
||||||
where
|
where
|
||||||
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
|
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
|
||||||
(lH, lHRest) = first reverse . splitAt 3 $ sortedXY
|
(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
|
(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
|
-- |This scans only a half of the convex hull. If it's the upper
|
||||||
-- 3 elements and want to stay efficient.
|
-- or lower half depends on the input.
|
||||||
scanH :: [PT] -- ^ the first 3 starting points in reversed order
|
-- 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] -- ^ the rest of the points
|
||||||
-> [PT] -- ^ all convex hull points for the half
|
-> [PT] -- ^ all convex hull points for the half
|
||||||
scanH hs@(x:y:z:xs) (r':rs')
|
scanH hs@(x:y:z:xs) (r':rs')
|
||||||
| notcw z y x = scanH (r':hs) rs'
|
| notcw z y x = scanH (r':hs) rs'
|
||||||
| otherwise = scanH (x:z:xs) (r':rs')
|
| otherwise = scanH (x:z:xs) (r':rs')
|
||||||
scanH hs@(x:y:z:xs) []
|
scanH hs@(x:y:z:xs) []
|
||||||
| notcw z y x = hs
|
| notcw z y x = hs
|
||||||
| otherwise = scanH (x:z:xs) []
|
| otherwise = scanH (x:z:xs) []
|
||||||
scanH hs (r':rs') = scanH (r':hs) rs'
|
scanH hs (r':rs') = scanH (r':hs) rs'
|
||||||
scanH hs _ = hs
|
scanH hs _ = hs
|
||||||
|
|
||||||
|
|
||||||
-- |Compute all steps of the graham scan algorithm to allow
|
-- |Compute all steps of the graham scan algorithm to allow
|
||||||
|
@ -52,7 +52,7 @@ convexHullPoints = Diag chp
|
|||||||
(repeat dot))
|
(repeat dot))
|
||||||
where
|
where
|
||||||
dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
|
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.
|
-- |Show coordinates as text above the convex hull points.
|
||||||
@ -64,7 +64,7 @@ convexHullPointsText = Diag chpt
|
|||||||
zip vtchf
|
zip vtchf
|
||||||
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
|
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
|
||||||
where
|
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
|
-- |Create a diagram which shows the lines along the convex hull
|
||||||
@ -76,10 +76,10 @@ convexHullLines = Diag chl
|
|||||||
chl p vt =
|
chl p vt =
|
||||||
(strokeTrail .
|
(strokeTrail .
|
||||||
fromVertices .
|
fromVertices .
|
||||||
flip (++) [head $ grahamGetCH vtf] .
|
flip (++) [head $ grahamCH vtf] .
|
||||||
grahamGetCH $
|
grahamCH $
|
||||||
vtf) #
|
vtf) #
|
||||||
moveTo (head $ grahamGetCH vtf) #
|
moveTo (head $ grahamCH vtf) #
|
||||||
lc red
|
lc red
|
||||||
where
|
where
|
||||||
vtf = filter (inRange (dX p) (dY p)) vt
|
vtf = filter (inRange (dX p) (dY p)) vt
|
||||||
|
Loading…
Reference in New Issue
Block a user