ALGO: improve readability
This commit is contained in:
parent
24810e5970
commit
6dc4fae415
@ -14,14 +14,14 @@ grahamGetCH :: [PT] -> [PT]
|
||||
grahamGetCH vs =
|
||||
-- merge upper hull with lower hull while discarding
|
||||
-- the duplicated points from the lower hull
|
||||
f (reverse uH) uHRest ++ tailInit (f (reverse lH) lHRest)
|
||||
scan uH uHRest ++ tailInit (scan lH lHRest)
|
||||
where
|
||||
-- sort lexicographically by x values (ties are resolved by y values)
|
||||
sortedVs = fmap p2 . sortLex . fmap unp2 $ vs
|
||||
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
|
||||
-- lists for lower hull
|
||||
(lH, lHRest) = splitAt 2 sortedVs
|
||||
(lH, lHRest) = first reverse . splitAt 2 $ sortedXY
|
||||
-- lists for upper hull
|
||||
(uH, uHRest) = splitAt 2 . reverse $ sortedVs
|
||||
(uH, uHRest) = first reverse . splitAt 2 . reverse $ sortedXY
|
||||
-- This is the actual algorithm.
|
||||
-- If we have a list say:
|
||||
-- [(100, 100), (200, 450), (250, 250), (300, 400), (400, 200)]
|
||||
@ -31,42 +31,45 @@ grahamGetCH vs =
|
||||
--
|
||||
-- The first list is reversed since we only care about the last
|
||||
-- 3 elements and want to stay efficient.
|
||||
f (y:z:xs) (x:ys)
|
||||
scan :: [PT] -- ^ the starting convex hull points
|
||||
-> [PT] -- ^ the rest of the points
|
||||
-> [PT] -- ^ all convex hull points
|
||||
scan (y:z:xs) (x:ys)
|
||||
-- last 3 elements are ccw, but there are elements left to check
|
||||
| ccw z y x = f (x:y:z:xs) ys
|
||||
| ccw z y x = scan (x:y:z:xs) ys
|
||||
-- not ccw, pop one out
|
||||
| otherwise = f (x:z:xs) ys
|
||||
f (x:y:z:xs) []
|
||||
| otherwise = scan (x:z:xs) ys
|
||||
scan (x:y:z:xs) []
|
||||
-- nothing left and last 3 elements are ccw, so return
|
||||
| ccw z y x = x:y:z:xs
|
||||
-- not ccw, pop one out
|
||||
| otherwise = f (x:z:xs) []
|
||||
f xs _ = xs
|
||||
| otherwise = scan (x:z:xs) []
|
||||
scan xs _ = xs
|
||||
|
||||
|
||||
-- |Compute all steps of the graham scan algorithm to allow
|
||||
-- visualizing it.
|
||||
grahamGetCHSteps :: [PT] -> [[PT]]
|
||||
grahamGetCHSteps vs =
|
||||
(++) (reverse . g (length vs) (reverse lH) $ lHRest) .
|
||||
fmap (\x -> (last . reverse . g (length vs) (reverse lH) $ lHRest)
|
||||
(++) (reverse . g (length vs) lH $ lHRest) .
|
||||
fmap (\x -> (last . reverse . g (length vs) lH $ lHRest)
|
||||
++ x) $
|
||||
(init . reverse . g (length vs) (reverse uH) $ uHRest)
|
||||
(init . reverse . g (length vs) uH $ uHRest)
|
||||
where
|
||||
sortedVs = fmap p2 . sortLex . fmap unp2 $ vs
|
||||
(lH, lHRest) = splitAt 2 sortedVs
|
||||
(uH, uHRest) = splitAt 2 . reverse $ sortedVs
|
||||
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
|
||||
(lH, lHRest) = first reverse . splitAt 2 $ sortedXY
|
||||
(uH, uHRest) = first reverse . splitAt 2 . reverse $ sortedXY
|
||||
g c xs' ys'
|
||||
| c >= 0 = f 0 xs' ys' : g (c - 1) xs' ys'
|
||||
| c >= 0 = scan 0 xs' ys' : g (c - 1) xs' ys'
|
||||
| otherwise = []
|
||||
where
|
||||
f c' (y:z:xs) (x:ys)
|
||||
scan c' (y:z:xs) (x:ys)
|
||||
| c' >= c = reverse (y:z:xs)
|
||||
| ccw z y x = f (c' + 1) (x:y:z:xs) ys
|
||||
| otherwise = f (c' + 1) (x:z:xs) ys
|
||||
f _ [x,y] [] = [y,x]
|
||||
f c' (x:y:z:xs) []
|
||||
| ccw z y x = scan (c' + 1) (x:y:z:xs) ys
|
||||
| otherwise = scan (c' + 1) (x:z:xs) ys
|
||||
scan _ [x,y] [] = [y,x]
|
||||
scan c' (x:y:z:xs) []
|
||||
| c' >= c = reverse (x:y:z:xs)
|
||||
| ccw z y x = x:y:z:xs
|
||||
| otherwise = f (c' + 1) (x:z:xs) []
|
||||
f _ xs _ = reverse xs
|
||||
| otherwise = scan (c' + 1) (x:z:xs) []
|
||||
scan _ xs _ = reverse xs
|
||||
|
Loading…
Reference in New Issue
Block a user