ALGO: improve naming of functions
This commit is contained in:
parent
825dd9baa9
commit
54284193cd
@ -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)
|
||||||
|
@ -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')
|
||||||
|
Loading…
Reference in New Issue
Block a user