ALGO: improve naming of functions

This commit is contained in:
hasufell 2015-01-09 03:58:05 +01:00
parent 825dd9baa9
commit 54284193cd
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 14 additions and 13 deletions

View File

@ -107,18 +107,16 @@ isYmonotone poly =
$ classifyList poly
monotonize :: [PT] -> [[PT]]
monotonize pts
| isYmonotone pts = partitionPoly pts
| and . fmap isYmonotone $ maybeMonotone =
concat . fmap partitionPoly $ maybeMonotone
| otherwise = (\(x, y) -> x ++ (concat . fmap monotonize $ y))
monotonePartitioning :: [PT] -> [[PT]]
monotonePartitioning pts
| isYmonotone pts = [pts]
| and . fmap isYmonotone $ maybeMonotone = maybeMonotone
| otherwise = (\(x, y) -> x ++ (concat . fmap monotonePartitioning $ y))
(partition isYmonotone maybeMonotone)
where
go (x:xs) = splitPoly pts x ++ go xs
go _ = []
maybeMonotone = go (monotoneDiagonals pts)
maybeMonotone = foldr (\x y -> splitPoly pts x ++ y)
[]
(monotoneDiagonals pts)
monotoneDiagonals :: [PT] -> [(PT, PT)]
@ -137,8 +135,8 @@ monotoneDiagonals pts = catMaybes . go $ classifyList pts
belowS pt pts' = reverse . takeWhile (/= pt) $ sortedYX pts'
partitionPoly :: [PT] -> [[PT]]
partitionPoly pts =
triangulate :: [PT] -> [[PT]]
triangulate pts =
go pts . A.first reverse . splitAt 3 . reverse . sortedYX $ pts
where
go xs (p@[_, _], r:rs) = go xs (r:p, rs)

View File

@ -270,6 +270,9 @@ monotonePolys :: Diag
monotonePolys = Diag f
where
f _ vts = foldl (\x y -> x <> strokePoly y) mempty
$ monotonize (concat vts)
(concat
. fmap triangulate
. monotonePartitioning
$ concat vts)
where
strokePoly x' = fromVertices $ x' ++ (maybeToList . headMay $ x')