ALGO: improve redability and style, add pseudo code
We also slightly changed the behavior of the algorithm and now split it at 3 elements. It doesn't matter complexity wise and improves readability a bit.
This commit is contained in:
parent
d3a7c04398
commit
bfcc9bfdf7
|
|
@ -10,41 +10,89 @@ 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)
|
||||
| isCounterClockWise (last3Elements lowerHull) == True
|
||||
= scanHalf (lowerHull + head rest) (tail rest)
|
||||
| otherwise
|
||||
= scanHalf (deleteSndToLastElem lowerHull + head rest)
|
||||
(tail rest)
|
||||
|
||||
scanHalf (min 3 elem => lowerHull ) []
|
||||
| isCounterClockWise (last3Elements lowerHull) == True
|
||||
= return lowerHull
|
||||
| otherwise
|
||||
= scanHalf (deleteSndToLastElem lowerHull) []
|
||||
|
||||
scanHalf lowerHull _ = lowerHull
|
||||
=== end scanHalf function ===
|
||||
|
||||
|
||||
============= SIMULATION ===================================
|
||||
xs = [(100, 100), (200, 450), (250, 250)]
|
||||
ys = [(300, 400), (400, 200)]
|
||||
|
||||
ccw (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)]
|
||||
|
||||
ccw (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 = []
|
||||
|
||||
ccw (250, 250) (300, 400) (400, 200) => false, pop snd2last of xs
|
||||
===
|
||||
xs = [(100, 100), (250, 250), (400, 200)]
|
||||
ys = []
|
||||
|
||||
ccw (100, 100) (250, 250) (400, 200) => false, pop snd2last of xs
|
||||
===
|
||||
xs = [(100, 100), (400, 200)]
|
||||
ys = []
|
||||
===
|
||||
return [(100, 100), (400, 200)]
|
||||
=========================================================
|
||||
--}
|
||||
grahamGetCH :: [PT] -> [PT]
|
||||
grahamGetCH vs =
|
||||
-- merge upper hull with lower hull while discarding
|
||||
-- the duplicated points from the lower hull
|
||||
scan uH uHRest ++ tailInit (scan lH lHRest)
|
||||
scanH uH uHRest ++ tailInit (scanH lH lHRest)
|
||||
where
|
||||
-- sort lexicographically by x values (ties are resolved by y values)
|
||||
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
|
||||
-- lists for lower hull
|
||||
(lH, lHRest) = first reverse . splitAt 2 $ sortedXY
|
||||
-- lists for upper hull
|
||||
(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)]
|
||||
--
|
||||
-- then this will start with:
|
||||
-- [(200, 450), (100, 100)] and [(250, 250), (300, 400), (400, 200)]
|
||||
--
|
||||
-- The first list is reversed since we only care about the last
|
||||
(lH, lHRest) = first reverse . splitAt 3 $ 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
|
||||
-- 3 elements and want to stay efficient.
|
||||
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 = scan (x:y:z:xs) ys
|
||||
-- not ccw, pop one out
|
||||
| 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 = scan (x:z:xs) []
|
||||
scan xs _ = xs
|
||||
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')
|
||||
| ccw z y x = scanH (r':hs) rs'
|
||||
| otherwise = scanH (r':x:z:xs) rs'
|
||||
scanH hs@(x:y:z:xs) []
|
||||
| ccw z y x = hs
|
||||
| otherwise = scanH (x:z:xs) []
|
||||
scanH xs _ = xs
|
||||
|
||||
|
||||
-- |Compute all steps of the graham scan algorithm to allow
|
||||
|
|
@ -55,19 +103,19 @@ grahamGetCHSteps vs =
|
|||
(rmdups . init . reverse . g (length vs) uH $ uHRest)
|
||||
where
|
||||
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
|
||||
(lH, lHRest) = first reverse . splitAt 2 $ sortedXY
|
||||
(uH, uHRest) = first reverse . splitAt 2 . reverse $ sortedXY
|
||||
(lH, lHRest) = first reverse . splitAt 3 $ sortedXY
|
||||
(uH, uHRest) = first reverse . splitAt 3 . reverse $ sortedXY
|
||||
g c xs' ys'
|
||||
| c >= 0 = scan 0 xs' ys' : g (c - 1) xs' ys'
|
||||
| c >= 0 = scanH 0 xs' ys' : g (c - 1) xs' ys'
|
||||
| otherwise = []
|
||||
where
|
||||
scan c' (y:z:xs) (x:ys)
|
||||
| c' >= c = 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 = x:y:z:xs
|
||||
| ccw z y x = x:y:z:xs
|
||||
| otherwise = scan (c' + 1) (x:z:xs) []
|
||||
scan _ xs _ = xs
|
||||
scanH c' hs@(x:y:z:xs) (r':rs')
|
||||
| c' >= c = hs
|
||||
| ccw z y x = scanH (c' + 1) (r':hs) rs'
|
||||
| otherwise = scanH (c' + 1) (r':x:z:xs) rs'
|
||||
scanH _ [x,y] [] = [y,x]
|
||||
scanH c' hs@(x:y:z:xs) []
|
||||
| c' >= c = hs
|
||||
| ccw z y x = hs
|
||||
| otherwise = scanH (c' + 1) (x:z:xs) []
|
||||
scanH _ xs _ = xs
|
||||
|
|
|
|||
Loading…
Reference in New Issue