hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ALGO: rewrite monotonePartitioning to avoid polygon duplicates

Browse Source
This commit is contained in:
hasufell 2015-01-12 22:27:17 +01:00
parent 3a1361b463
commit f383cc65b2
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Algorithms/PolygonTriangulation.hs
View File

@ -5,7 +5,6 @@ module Algorithms.PolygonTriangulation where
import Algebra.Polygon import Algebra.Polygon
import Algebra.Vector import Algebra.Vector
import qualified Control.Arrow as A import qualified Control.Arrow as A
import Data.List
import Data.Maybe import Data.Maybe
import Safe import Safe
@ -111,13 +110,16 @@ isYmonotone poly =
monotonePartitioning :: [PT] -> [[PT]] monotonePartitioning :: [PT] -> [[PT]]
monotonePartitioning pts monotonePartitioning pts
| isYmonotone pts = [pts] | isYmonotone pts = [pts]
| and . fmap isYmonotone $ maybeMonotone = maybeMonotone | otherwise = go (monotoneDiagonals pts) pts
| otherwise = (\(x, y) -> x ++ (concat . fmap monotonePartitioning $ y))
(partition isYmonotone maybeMonotone)
where where
maybeMonotone = foldr (\x y -> splitPoly pts x ++ y) go [] _ = [[]]
[] go _ [] = [[]]
(monotoneDiagonals pts) go (x:xs) pts'
| isYmonotone a && isYmonotone b = [a, b]
| isYmonotone b = b : go xs a
| otherwise = a : go xs b
where
[a, b] = splitPoly pts' x
-- |Try to eliminate the merge and split vertices by computing the -- |Try to eliminate the merge and split vertices by computing the