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

View File

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