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

Add getSquareByZipper function

Browse Source
This commit is contained in:
hasufell 2014-11-14 21:26:02 +01:00
parent 76afaae38e
commit 534f0f9609
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Algorithms/RangeSearch/Core.hs
View File

@ -6,6 +6,7 @@ module Algorithms.RangeSearch.Core
goQuad, goQuad,
findNeighbor, findNeighbor,
lookupByPath', lookupByPath',
getSquareByZipper,
rootNode, rootNode,
testArr, testArr,
Orient(North,East,West,South), Orient(North,East,West,South),
@ -101,6 +102,18 @@ quadTreeSquares sq (TNode nw ne sw se) =
quadTreeSquares (swSq sq) sw ++ quadTreeSquares (seSq sq) se quadTreeSquares (swSq sq) sw ++ quadTreeSquares (seSq sq) se
-- |Get the current square of the zipper, relative to the to the given top
-- square.
getSquareByZipper :: Square -> Zipper a -> Square
getSquareByZipper sq z = go sq (reverse . snd $ z)
where
go sq' [] = sq'
go sq' (NWCrumb {}:zs) = go (nwSq sq') zs
go sq' (NECrumb {}:zs) = go (neSq sq') zs
go sq' (SWCrumb {}:zs) = go (swSq sq') zs
go sq' (SECrumb {}:zs) = go (seSq sq') zs
-- |Left fold over the tree leafs. -- |Left fold over the tree leafs.
qtFoldl :: (a -> b -> a) -> a -> QuadTree b -> a qtFoldl :: (a -> b -> a) -> a -> QuadTree b -> a
qtFoldl _ sv (TNil) = sv qtFoldl _ sv (TNil) = sv