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

Remove almost all 'type' usage to make types more transparent

Browse Source
This commit is contained in:
hasufell
2015-01-14 18:17:35 +01:00
parent 1c131825ab
commit 5120a44d0f
12 changed files with 172 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
Algorithms/QuadTree.hs
View File

@@ -56,7 +56,8 @@ data Orient = North | South | East | West
-- |Get a sub-square of the current square, e.g. nw, ne, sw or se.
nwSq, neSq, swSq, seSq :: Square -> Square
nwSq, neSq, swSq, seSq :: ((Double, Double), (Double, Double)) -- ^ current square
-> ((Double, Double), (Double, Double)) -- ^ sub-square
nwSq ((xl, yl), (xu, yu)) = (,) (xl, (yl + yu) / 2) ((xl + xu) / 2, yu)
neSq ((xl, yl), (xu, yu)) = (,) ((xl + xu) / 2, (yl + yu) / 2) (xu, yu)
swSq ((xl, yl), (xu, yu)) = (,) (xl, yl) ((xl + xu) / 2, (yl + yu) / 2)
@@ -79,9 +80,9 @@ isSEchild _ = False
-- |Builds a quadtree of a list of points which recursively divides up 2D
-- space into quadrants, so that every leaf-quadrant stores either zero or one
-- point.
quadTree :: [PT] -- ^ the points to divide
-> Square -- ^ the initial square around the points
-> QuadTree PT -- ^ the quad tree
quadTree :: [P2] -- ^ the points to divide
-> ((Double, Double), (Double, Double)) -- ^ the initial square around the points
-> QuadTree P2 -- ^ the quad tree
quadTree [] _ = TNil
quadTree [pt] _ = TLeaf pt
quadTree pts sq = TNode (quadTree nWPT . nwSq $ sq) (quadTree nEPT . neSq $ sq)
@@ -95,9 +96,9 @@ quadTree pts sq = TNode (quadTree nWPT . nwSq $ sq) (quadTree nEPT . neSq $ sq)
-- |Get all squares of a quad tree.
quadTreeSquares :: Square -- ^ the initial square around the points
-> QuadTree PT -- ^ the quad tree
-> [Square] -- ^ all squares of the quad tree
quadTreeSquares :: ((Double, Double), (Double, Double)) -- ^ the initial square around the points
-> QuadTree P2 -- ^ the quad tree
-> [((Double, Double), (Double, Double))] -- ^ all squares of the quad tree
quadTreeSquares sq (TNil) = [sq]
quadTreeSquares sq (TLeaf _) = [sq]
quadTreeSquares sq (TNode nw ne sw se) =
@@ -107,7 +108,9 @@ quadTreeSquares sq (TNode nw ne sw se) =
-- |Get the current square of the zipper, relative to the given top
-- square.
getSquareByZipper :: Square -> QTZipper a -> Square
getSquareByZipper :: ((Double, Double), (Double, Double)) -- ^ top square
-> QTZipper a
-> ((Double, Double), (Double, Double)) -- ^ current square
getSquareByZipper sq z = go sq (reverse . snd $ z)
where
go sq' [] = sq'
@@ -200,7 +203,7 @@ lookupByNeighbors :: [Orient] -> QTZipper a -> Maybe (QTZipper a)
lookupByNeighbors = flip (foldlM (flip findNeighbor))
quadTreeToRoseTree :: QTZipper PT -> Tree String
quadTreeToRoseTree :: QTZipper P2 -> Tree String
quadTreeToRoseTree z' = go (rootNode z')
where
go z = case z of