ALGO: refactor

Move sortedXY to Vector.hs, fix shadowing of scanH.
Simplified grahamCHSteps by making use of a more generalized scanH
function.
This commit is contained in:
hasufell 2014-10-13 22:06:12 +02:00
parent 09eeaeda27
commit 8300929fd7
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 29 additions and 47 deletions

View File

@ -4,6 +4,7 @@ module Algebra.Vector where
import Algebra.VectorTypes
import Diagrams.TwoD.Types
import MyPrelude
-- |Checks whether the Point is in a given dimension.
@ -89,3 +90,8 @@ notcw :: PT -> PT -> PT -> Bool
notcw a b c = case getOrient a b c of
CW -> False
_ -> True
-- |Sort X and Y coordinates lexicographically.
sortedXY :: [PT] -> [PT]
sortedXY = fmap p2 . sortLex . fmap unp2

View File

@ -4,7 +4,6 @@ module Algorithms.ConvexHull.GrahamScan where
import Algebra.Vector
import Algebra.VectorTypes
import Diagrams.TwoD.Types
import MyPrelude
@ -82,81 +81,58 @@ 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
grahamLCH vs = uncurry (\x y -> last . scanH x $ y)
(first reverse . splitAt 3 . sortedXY $ vs)
-- |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
grahamUCH vs = uncurry (\x y -> last . scanH x $ y)
(first reverse . splitAt 3 . reverse . sortedXY $ vs)
-- |This scans only a half of the convex hull. If it's the upper
-- or lower half depends on the input.
-- |This scans only a half of the convex hull, but all steps (the last
-- is the end result).
-- 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 :: [PT] -- ^ the first 3 starting points in reversed order
-> [PT] -- ^ the rest of the points
-> [[PT]] -- ^ all convex hull points iterations 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')
| notcw z y x = [hs] ++ scanH (r':hs) rs'
| otherwise = [hs] ++ 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
| notcw z y x = [hs]
| otherwise = [hs] ++ scanH (x:z:xs) []
scanH hs (r':rs') = [hs] ++ scanH (r':hs) rs'
scanH hs _ = [hs]
-- |Compute all steps of the graham scan algorithm to allow
-- visualizing it.
-- Whether the upper or lower hull is computed depends on the input.
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
grahamCHSteps c xs' ys' = take c . scanH xs' $ ys'
-- |Get all iterations of the upper hull of the graham scan algorithm.
grahamUHSteps :: [PT] -> [[PT]]
grahamUHSteps vs =
(++) [getLastX 2 sortedXY] .
(++) [getLastX 2 . sortedXY $ vs] .
rmdups .
init .
reverse .
grahamCHSteps ((* 2) . length $ vs) uH $
grahamCHSteps ((* 2) . length $ vs) 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 $ vs
-- |Get all iterations of the lower hull of the graham scan algorithm.
grahamLHSteps :: [PT] -> [[PT]]
grahamLHSteps vs =
(++) [take 2 sortedXY] .
(++) [take 2 . sortedXY $ vs] .
rmdups .
reverse .
grahamCHSteps ((* 2) . length $ vs) lH $
grahamCHSteps ((* 2) . length $ vs) lH $
lHRest
where
sortedXY = fmap p2 . sortLex . fmap unp2 $ vs
(lH, lHRest) = first reverse . splitAt 3 $ sortedXY
(lH, lHRest) = first reverse . splitAt 3 . sortedXY $ vs