kdt 0.1.0 → 0.2.0
raw patch · 11 files changed
+671/−509 lines, 11 files
Files
- app-src/Benchmarks/KDTBenchmark.hs +10/−10
- app-src/Tests/DynamicTest.hs +113/−0
- app-src/Tests/KdTreeTest.hs +0/−10
- app-src/Tests/StaticTest.hs +144/−0
- changelog.md +6/−0
- kdt.cabal +25/−9
- lib-src/Data/KdMap/Dynamic.hs +72/−160
- lib-src/Data/KdMap/Static.hs +142/−199
- lib-src/Data/KdTree/Dynamic.hs +49/−43
- lib-src/Data/KdTree/Static.hs +110/−51
- lib-src/Data/Point2d.hs +0/−27
app-src/Benchmarks/KDTBenchmark.hs view
@@ -25,9 +25,9 @@ (DKDT.KdTree Double Point2d, [Point2d]) f (kdt, accList) (treePt, queryPt) = let newKdt = DKDT.insert kdt treePt- nearest = DKDT.nearestNeighbor newKdt queryPt- in (newKdt, nearest : accList)- start = (DKDT.emptyKdTreeWithDistFn pointAsList2d distSqr2d, [])+ near = DKDT.nearest newKdt queryPt+ in (newKdt, near : accList)+ start = (DKDT.emptyWithDist pointAsList2d distSqr2d, []) in snd . foldl' f start -- nn implemented with optimized linear scan@@ -76,33 +76,33 @@ rangeOfPointKdt :: KDT.KdTree Double Point2d -> Double -> Point2d -> [Point2d] rangeOfPointKdt kdt w q = let (lowers, uppers) = pointToBounds q w- in KDT.pointsInRange kdt lowers uppers+ in KDT.inRange kdt lowers uppers linearInterleaveBuildQuery :: [(Point2d, Point2d)] -> [Point2d] linearInterleaveBuildQuery = let f :: ([Point2d], [Point2d]) -> (Point2d, Point2d) -> ([Point2d], [Point2d]) f (ps, accList) (structPt, queryPt) = let ps' = structPt : ps- nearest = nearestLinear ps' queryPt- in (ps', nearest : accList)+ near = nearestLinear ps' queryPt+ in (ps', near : accList) in snd . foldl' f ([], []) main :: IO () main = let seed = 1 treePoints = CMR.evalRand (sequence $ repeat zeroOnePointSampler) $ pureMT seed- kdtN n = KDT.buildKdTreeWithDistFn pointAsList2d distSqr2d $ take n treePoints+ kdtN n = KDT.buildWithDist pointAsList2d distSqr2d $ take n treePoints queryPoints = CMR.evalRand (sequence $ repeat zeroOnePointSampler) $ pureMT (seed + 1) buildKdtBench n = bench (show n) $ nf kdtN n nnKdtBench nq np = bench ("np-" ++ show np ++ "-nq-" ++ show nq) $- nf (map (KDT.nearestNeighbor (kdtN np))) (take nq queryPoints)+ nf (map (KDT.nearest (kdtN np))) (take nq queryPoints) inRadKdtBench nq r np = bench ("np-" ++ show np ++ "-nq-" ++ show nq ++ "-r-" ++ show r) $- nf (map (KDT.pointsInRadius (kdtN np) r)) (take nq queryPoints)+ nf (map (KDT.inRadius (kdtN np) r)) (take nq queryPoints) knnKdtBench nq k np = bench ("np-" ++ show np ++ "-nq-" ++ show nq ++ "-k-" ++ show k) $- nf (map (KDT.kNearestNeighbors (kdtN np) k)) (take nq queryPoints)+ nf (map (KDT.kNearest (kdtN np) k)) (take nq queryPoints) rangeKdtBench nq w np = bench ("np-" ++ show np ++ "-nq-" ++ show nq ++ "-w-" ++ show w) $ nf (map $ rangeOfPointKdt (kdtN np) w) (take nq queryPoints)
+ app-src/Tests/DynamicTest.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TemplateHaskell #-}++import qualified Data.KdMap.Static as KDM+import Data.KdMap.Dynamic++import Control.Monad+import Data.Bits+import Data.List+import Data.Point2d+import System.Exit+import Test.QuickCheck++testElements :: [p] -> [(p, Int)]+testElements ps = zip ps [1 ..]++checkLogNTrees :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> [p] -> Bool+checkLogNTrees p2l d2 ps =+ let lengthIsLogN kdm = length (subtreeSizes kdm) == popCount (size kdm)+ in all lengthIsLogN $ scanl insertPair (emptyWithDist p2l d2) $ testElements ps++prop_logNTrees :: [Point2d] -> Bool+prop_logNTrees = checkLogNTrees pointAsList2d distSqr2d++checkTreeSizesPowerOf2 :: Real a => PointAsListFn a p ->+ SquaredDistanceFn a p ->+ [p] ->+ Bool+checkTreeSizesPowerOf2 p2l d2 ps =+ let sizesPowerOf2 = all ((== 1) . popCount) . subtreeSizes+ in all sizesPowerOf2 $ scanl insertPair (emptyWithDist p2l d2) $ testElements ps++prop_treeSizesPowerOf2 :: [Point2d] -> Bool+prop_treeSizesPowerOf2 = checkTreeSizesPowerOf2 pointAsList2d distSqr2d++checkNumElements :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> [p] -> Bool+checkNumElements p2l d2 ps =+ let numsMatch (num, kdm) = size kdm == num && num == sum (subtreeSizes kdm)+ in all numsMatch $ zip [0..] $ scanl insertPair (emptyWithDist p2l d2) $ testElements ps++prop_validNumElements :: [Point2d] -> Bool+prop_validNumElements = checkNumElements pointAsList2d distSqr2d++checkNearestEqualToBatch :: (Eq p, Real a) => PointAsListFn a p ->+ SquaredDistanceFn a p ->+ ([p], p) ->+ Bool+checkNearestEqualToBatch p2l d2 (ps, query) =+ let kdt = KDM.buildWithDist p2l d2 $ testElements ps+ kdtAnswer = KDM.nearest kdt query+ dkdt = batchInsert (emptyWithDist p2l d2) $ testElements ps+ dkdtAnswer = nearest dkdt query+ in dkdtAnswer == kdtAnswer++prop_nearestEqualToBatch :: Point2d -> Property+prop_nearestEqualToBatch query =+ forAll (listOf1 arbitrary) $ \xs ->+ checkNearestEqualToBatch pointAsList2d distSqr2d (xs, query)++checkKNearestEqualToBatch :: (Eq p, Real a) => PointAsListFn a p ->+ SquaredDistanceFn a p ->+ ([p], Int, p) ->+ Bool+checkKNearestEqualToBatch p2l d2 (ps, k, query) =+ let kdt = KDM.buildWithDist p2l d2 $ testElements ps+ kdtAnswer = KDM.kNearest kdt k query+ dkdt = batchInsert (emptyWithDist p2l d2) $ testElements ps+ dkdtAnswer = kNearest dkdt k query+ in dkdtAnswer == kdtAnswer++prop_kNearestEqualToBatch :: Point2d -> Property+prop_kNearestEqualToBatch query =+ forAll (listOf1 arbitrary) $ \xs ->+ forAll (choose (1, length xs)) $ \k ->+ checkKNearestEqualToBatch pointAsList2d distSqr2d (xs, k, query)++checkInRadiusEqualToBatch :: (Ord p, Real a) => PointAsListFn a p ->+ SquaredDistanceFn a p ->+ ([p], a, p) ->+ Bool+checkInRadiusEqualToBatch p2l d2 (ps, radius, query) =+ let kdt = KDM.buildWithDist p2l d2 $ testElements ps+ kdtAnswer = KDM.inRadius kdt radius query+ dkdt = batchInsert (emptyWithDist p2l d2) $ testElements ps+ dkdtAnswer = inRadius dkdt radius query+ in sort dkdtAnswer == sort kdtAnswer++prop_checkInRadiusEqualToBatch :: Point2d -> Property+prop_checkInRadiusEqualToBatch query =+ forAll (listOf1 arbitrary) $ \xs ->+ forAll (choose (0.0, 1000.0)) $ \radius ->+ checkInRadiusEqualToBatch pointAsList2d distSqr2d (xs, radius, query)++prop_checkInRangeEqualToBatch :: ([Point2d], Point2d, Point2d) -> Bool+prop_checkInRangeEqualToBatch ([], _, _) = True+prop_checkInRangeEqualToBatch (xs, lowers, uppers)+ | and $ zipWith (<) (pointAsList2d lowers) (pointAsList2d uppers) =+ let kdt = KDM.buildWithDist pointAsList2d distSqr2d $ testElements xs+ kdtAnswer = KDM.inRange kdt lowers uppers+ dkdt = batchInsert (emptyWithDist pointAsList2d distSqr2d) $ testElements xs+ dkdtAnswer = inRange dkdt lowers uppers+ in sort dkdtAnswer == sort kdtAnswer+ | otherwise = True+++-- Run all tests+return []+runTests :: IO Bool+runTests = $quickCheckAll++main :: IO ()+main = do+ success <- runTests+ unless success exitFailure
− app-src/Tests/KdTreeTest.hs
@@ -1,10 +0,0 @@-import Data.KdMap.Static as KDM-import Data.KdMap.Dynamic as DKDM--import Control.Monad-import System.Exit--main :: IO ()-main = do- success <- liftM2 (&&) KDM.runTests DKDM.runTests- unless success exitFailure
+ app-src/Tests/StaticTest.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE TemplateHaskell #-}++import Data.KdMap.Static as KDM++import Control.Monad+import Data.List+import Data.Ord+import Data.Point2d+import System.Exit+import Test.QuickCheck++testElements :: [p] -> [(p, Int)]+testElements ps = zip ps [0 ..]++prop_validTree :: Property+prop_validTree =+ forAll (listOf1 arbitrary) $ isValid . build pointAsList2d . testElements++checkElements :: (Ord p, Real a) => PointAsListFn a p -> [p] -> Bool+checkElements pointAsList ps =+ let kdt = build pointAsList $ testElements ps+ in sort (assocs kdt) == sort (testElements ps)++prop_sameElements :: Property+prop_sameElements = forAll (listOf1 arbitrary) $ checkElements pointAsList2d++checkNumElements :: Real a => PointAsListFn a p -> [p] -> Bool+checkNumElements pointAsList ps =+ let kdm = build pointAsList $ testElements ps+ in size kdm == length ps++prop_validNumElements :: Property+prop_validNumElements = forAll (listOf1 arbitrary) $ checkNumElements pointAsList2d++nearestLinear :: Real a => KDM.PointAsListFn a p -> [(p, v)] -> p -> (p, v)+nearestLinear pointAsList xs query =+ minimumBy (comparing (KDM.defaultSqrDist pointAsList query . fst)) xs++checkNearestEqualToLinear :: (Eq p, Real a) => KDM.PointAsListFn a p -> ([p], p) -> Bool+checkNearestEqualToLinear pointAsList (ps, query) =+ let kdt = build pointAsList $ testElements ps+ in nearest kdt query == nearestLinear pointAsList (testElements ps) query++prop_nearestEqualToLinear :: Point2d -> Property+prop_nearestEqualToLinear query =+ forAll (listOf1 arbitrary) $ \xs ->+ checkNearestEqualToLinear pointAsList2d (xs, query)++inRadiusLinear :: Real a => KDM.PointAsListFn a p -> [(p, v)] -> p -> a -> [(p, v)]+inRadiusLinear pointAsList xs query radius =+ filter ((<= radius * radius) . defaultSqrDist pointAsList query . fst) xs++checkInRadiusEqualToLinear :: (Ord p, Real a) => KDM.PointAsListFn a p -> a -> ([p], p) -> Bool+checkInRadiusEqualToLinear pointAsList radius (ps, query) =+ let kdt = build pointAsList $ testElements ps+ kdtNear = inRadius kdt radius query+ linearNear = inRadiusLinear pointAsList (testElements ps) query radius+ in sort kdtNear == sort linearNear++prop_inRadiusEqualToLinear :: Point2d -> Property+prop_inRadiusEqualToLinear query =+ forAll (listOf1 arbitrary) $ \xs ->+ forAll (choose (0.0, 1000.0)) $ \radius ->+ checkInRadiusEqualToLinear pointAsList2d radius (xs, query)++kNearestLinear :: Real a => KDM.PointAsListFn a p -> [(p, v)] -> p -> Int -> [(p, v)]+kNearestLinear pointAsList xs query k =+ take k $ sortBy (comparing (defaultSqrDist pointAsList query . fst)) xs++checkKNearestEqualToLinear :: (Ord p, Real a) => KDM.PointAsListFn a p -> Int -> ([p], p) -> Bool+checkKNearestEqualToLinear pointAsList k (xs, query) =+ let kdt = build pointAsList $ testElements xs+ kdtKNear = kNearest kdt k query+ linearKNear = kNearestLinear pointAsList (testElements xs) query k+ in kdtKNear == linearKNear++prop_kNearestEqualToLinear :: Point2d -> Property+prop_kNearestEqualToLinear query =+ forAll (listOf1 arbitrary) $ \xs ->+ forAll (choose (1, length xs)) $ \k ->+ checkKNearestEqualToLinear pointAsList2d k (xs, query)++checkKNearestSorted :: (Eq p, Real a) => KDM.PointAsListFn a p -> ([p], p) -> Bool+checkKNearestSorted _ ([], _) = True+checkKNearestSorted pointAsList (ps, query) =+ let kdt = build pointAsList $ testElements ps+ kNearestDists =+ map (defaultSqrDist pointAsList query . fst) $ kNearest kdt (length ps) query+ in kNearestDists == sort kNearestDists++prop_kNearestSorted :: Point2d -> Property+prop_kNearestSorted query =+ forAll (listOf1 arbitrary) $ \xs ->+ checkKNearestSorted pointAsList2d (xs, query)++rangeLinear :: Real a => KDM.PointAsListFn a p -> [(p, v)] -> p -> p -> [(p, v)]+rangeLinear pointAsList xs lowers uppers =+ let valInRange a lower upper = lower <= a && a <= upper+ lowersAsList = pointAsList lowers+ uppersAsList = pointAsList uppers+ pointInRange (p, _) =+ and $ zipWith3 valInRange (pointAsList p) lowersAsList uppersAsList+ in filter pointInRange xs++prop_rangeEqualToLinear :: ([Point2d], Point2d, Point2d) -> Bool+prop_rangeEqualToLinear (xs, lowers, uppers)+ | Data.List.null xs = True+ | and $ zipWith (<) (pointAsList2d lowers) (pointAsList2d uppers) =+ let linear = rangeLinear pointAsList2d (testElements xs) lowers uppers+ kdt = build pointAsList2d $ testElements xs+ kdtPoints = inRange kdt lowers uppers+ in sort linear == sort kdtPoints+ | otherwise = True++prop_equalAxisValueSameElems :: Property+prop_equalAxisValueSameElems =+ forAll (listOf1 arbitrary) $ \xs@(Point2d x y : _) ->+ checkElements pointAsList2d $ Point2d x (y + 1) : xs++prop_equalAxisValueEqualToLinear :: Point2d -> Property+prop_equalAxisValueEqualToLinear query =+ forAll (listOf1 arbitrary) $ \xs@(Point2d x y : _) ->+ checkNearestEqualToLinear pointAsList2d (Point2d x (y + 1) : xs, query)++prop_unbalancedInsertValid :: Property+prop_unbalancedInsertValid =+ forAll (listOf1 arbitrary) $+ isValid . batchInsertUnbalanced (empty pointAsList2d) . testElements++prop_unbalancedInsertNNEqualToLinear :: Point2d -> Property+prop_unbalancedInsertNNEqualToLinear query =+ forAll (listOf1 arbitrary) $ \xs ->+ let kdm = batchInsertUnbalanced (empty pointAsList2d) $ testElements xs+ in nearest kdm query == nearestLinear pointAsList2d (testElements xs) query++-- Run all tests+return []+runTests :: IO Bool+runTests = $quickCheckAll++main :: IO ()+main = do+ success <- runTests+ unless success exitFailure
+ changelog.md view
@@ -0,0 +1,6 @@+# 0.2.0+* Lots and lots of renaming all throughout to more closely match terminology used in `containers`.+* Removed kdt library dependency on QuickCheck (if not building testing code).+* Removed testing module Point2d from public API+* All structures now have Show instance+* Static variants now have functions for dynamically inserting new points into existing structure, with caveat that these functions do not maintain balanced tree structure.
kdt.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: kdt-version: 0.1.0+version: 0.2.0 synopsis: Fast and flexible k-d trees for various types of point queries. description: This package includes static and dynamic versions of k-d trees, as well as \"Map\" variants that store data at each point in the@@ -19,7 +19,7 @@ copyright: Luis G. Torres, 2014 category: Data build-type: Simple--- extra-source-files:+extra-source-files: changelog.md cabal-version: >=1.10 source-repository head type: git@@ -30,29 +30,42 @@ exposed-modules: Data.KdMap.Static, Data.KdTree.Static, Data.KdMap.Dynamic,- Data.KdTree.Dynamic,- Data.Point2d+ Data.KdTree.Dynamic -- other-modules: other-extensions: DeriveGeneric, TemplateHaskell ghc-options: -Wall -O3 ghc-prof-options: -Wall -O3 -fprof-auto build-depends: base >=4.6 && <4.8, deepseq >=1.3 && <1.4,- QuickCheck >=2.7 && <2.8, pqueue >=1.2.1 && <1.3, deepseq-generics >=0.1.1.1 hs-source-dirs: lib-src default-language: Haskell2010 -Test-Suite KdTreeTest+Test-Suite StaticTest type: exitcode-stdio-1.0- main-is: Tests/KdTreeTest.hs+ main-is: Tests/StaticTest.hs hs-source-dirs: app-src ghc-options: -Wall -O3 build-depends: base >=4.6 && <4.8,- kdt -any+ kdt -any,+ QuickCheck >=2.7 && <2.8,+ deepseq >=1.3 && <1.4,+ deepseq-generics >=0.1.1.1 default-language: Haskell2010 +Test-Suite DynamicTest+ type: exitcode-stdio-1.0+ main-is: Tests/DynamicTest.hs+ hs-source-dirs: app-src+ ghc-options: -Wall -O3+ build-depends: base >=4.6 && <4.8,+ kdt -any,+ QuickCheck >=2.7 && <2.8,+ deepseq >=1.3 && <1.4,+ deepseq-generics >=0.1.1.1+ default-language: Haskell2010+ benchmark KDTBenchmark type: exitcode-stdio-1.0 main-is: Benchmarks/KDTBenchmark.hs@@ -65,5 +78,8 @@ MonadRandom >= 0.1.12 && <0.2, mersenne-random-pure64 >=0.2.0.4 && <0.3, criterion >= 1.0.0.0 && <1.1,- pqueue >=1.2.1 && <1.3+ pqueue >=1.2.1 && <1.3,+ QuickCheck >=2.7 && <2.8,+ deepseq >=1.3 && <1.4,+ deepseq-generics >=0.1.1.1 default-language: Haskell2010
lib-src/Data/KdMap/Dynamic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-} module Data.KdMap.Dynamic ( -- * Usage@@ -12,33 +12,35 @@ , SquaredDistanceFn , KdMap -- ** Dynamic /k/-d map construction- , emptyKdMap+ , empty , singleton- , emptyKdMapWithDistFn- , singletonWithDistFn+ , emptyWithDist+ , singletonWithDist -- ** Insertion , insert+ , insertPair , batchInsert -- ** Query- , nearestNeighbor- , pointsInRadius- , kNearestNeighbors- , pointsInRange+ , nearest+ , inRadius+ , kNearest+ , inRange , assocs- , points- , values+ , keys+ , elems , null , size -- ** Folds- , foldrKdMap+ , foldrWithKey -- ** Utilities- , defaultDistSqrFn- , runTests+ , defaultSqrDist+ -- ** Internal (for testing)+ , subtreeSizes ) where import Prelude hiding (null) -import Control.Applicative+import Control.Applicative hiding (empty) import Data.Bits import Data.Foldable import Data.Function@@ -49,11 +51,9 @@ import Control.DeepSeq import Control.DeepSeq.Generics (genericRnf) import GHC.Generics-import Test.QuickCheck hiding ((.&.)) -import Data.Point2d import qualified Data.KdMap.Static as KDM-import Data.KdMap.Static (PointAsListFn, SquaredDistanceFn, defaultDistSqrFn)+import Data.KdMap.Static (PointAsListFn, SquaredDistanceFn, defaultSqrDist) -- $usage --@@ -67,16 +67,16 @@ -- 'String's: -- -- @--- >>> let dkdm = singleton point3dAsList ((Point3D 0.0 0.0 0.0), \"First\")+-- >>> let dkdm = 'singleton' point3dAsList ((Point3D 0.0 0.0 0.0), \"First\") ----- >>> let dkdm' = insert dkdm ((Point3D 1.0 1.0 1.0), \"Second\")+-- >>> let dkdm' = 'insert' dkdm ((Point3D 1.0 1.0 1.0), \"Second\") ----- >>> nearestNeighbor dkdm' (Point3D 0.4 0.4 0.4)+-- >>> 'nearest' dkdm' (Point3D 0.4 0.4 0.4) -- (Point3D {x = 0.0, y = 0.0, z = 0.0}, \"First\") ----- >>> let dkdm'' = insert dkdm' ((Point3D 0.5 0.5 0.5), \"Third\")+-- >>> let dkdm'' = 'insert' dkdm' ((Point3D 0.5 0.5 0.5), \"Third\") ----- >>> nearestNeighbor dkdm'' (Point3D 0.4 0.4 0.4)+-- >>> 'nearest' dkdm'' (Point3D 0.4 0.4 0.4) -- (Point3D {x = 0.5, y = 0.5, z = 0.5}, \"Third\") -- @ @@ -91,23 +91,26 @@ } deriving Generic instance (NFData a, NFData p, NFData v) => NFData (KdMap a p v) where rnf = genericRnf +instance (Show a, Show p, Show v) => Show (KdMap a p v) where+ show kdm = "KdMap " ++ show (_trees kdm)+ instance Functor (KdMap a p) where fmap f dkdMap = dkdMap { _trees = map (fmap f) $ _trees dkdMap } -- | Performs a foldr over each point-value pair in the 'KdMap'.-foldrKdMap :: ((p, v) -> b -> b) -> b -> KdMap a p v -> b-foldrKdMap f z dkdMap = L.foldr (flip $ KDM.foldrKdMap f) z $ _trees dkdMap+foldrWithKey :: ((p, v) -> b -> b) -> b -> KdMap a p v -> b+foldrWithKey f z dkdMap = L.foldr (flip $ KDM.foldrWithKey f) z $ _trees dkdMap instance Foldable (KdMap a p) where- foldr f = foldrKdMap (f . snd)+ foldr f = foldrWithKey (f . snd) instance Traversable (KdMap a p) where traverse f (KdMap t p d n) = KdMap <$> traverse (traverse f) t <*> pure p <*> pure d <*> pure n -- | Generates an empty 'KdMap' with a user-specified distance function.-emptyKdMapWithDistFn :: PointAsListFn a p -> SquaredDistanceFn a p -> KdMap a p v-emptyKdMapWithDistFn p2l d2 = KdMap [] p2l d2 0+emptyWithDist :: PointAsListFn a p -> SquaredDistanceFn a p -> KdMap a p v+emptyWithDist p2l d2 = KdMap [] p2l d2 0 -- | Returns whether the 'KdMap' is empty. null :: KdMap a p v -> Bool@@ -116,18 +119,21 @@ -- | Generates a 'KdMap' with a single point-value pair using a -- user-specified distance function.-singletonWithDistFn :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> (p, v) -> KdMap a p v-singletonWithDistFn p2l d2 (k, v) =- KdMap [KDM.buildKdMapWithDistFn p2l d2 [(k, v)]] p2l d2 1+singletonWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> (p, v)+ -> KdMap a p v+singletonWithDist p2l d2 (k, v) =+ KdMap [KDM.buildWithDist p2l d2 [(k, v)]] p2l d2 1 -- | Generates an empty 'KdMap' with the default distance function.-emptyKdMap :: Real a => PointAsListFn a p -> KdMap a p v-emptyKdMap p2l = emptyKdMapWithDistFn p2l $ defaultDistSqrFn p2l+empty :: Real a => PointAsListFn a p -> KdMap a p v+empty p2l = emptyWithDist p2l $ defaultSqrDist p2l -- | Generates a 'KdMap' with a single point-value pair using the -- default distance function. singleton :: Real a => PointAsListFn a p -> (p, v) -> KdMap a p v-singleton p2l = singletonWithDistFn p2l $ defaultDistSqrFn p2l+singleton p2l = singletonWithDist p2l $ defaultSqrDist p2l -- | Adds a given point-value pair to a 'KdMap'. --@@ -137,23 +143,24 @@ let bitList = map ((1 .&.) . (n `shiftR`)) [0..] (onesPairs, theRestPairs) = span ((== 1) . fst) $ zip bitList trees ((_, ones), (_, theRest)) = (unzip onesPairs, unzip theRestPairs)- newTree = KDM.buildKdMapWithDistFn p2l d2 $ (k, v) : L.concatMap KDM.assocs ones+ newTree = KDM.buildWithDist p2l d2 $ (k, v) : L.concatMap KDM.assocs ones in KdMap (newTree : theRest) p2l d2 $ n + 1 +-- | Same as 'insert', but takes point and value as a pair.+insertPair :: Real a => KdMap a p v -> (p, v) -> KdMap a p v+insertPair t = uncurry (insert t)+ -- | Given a 'KdMap' and a query point, returns the point-value pair in -- the 'KdMap' with the point nearest to the query. -- -- Average time complexity: /O(log^2(n))/.-nearestNeighbor :: Real a => KdMap a p v -> p -> (p, v)-nearestNeighbor (KdMap ts _ d2 _) query =- let nearests = map (`KDM.nearestNeighbor` query) ts+nearest :: Real a => KdMap a p v -> p -> (p, v)+nearest (KdMap ts _ d2 _) query =+ let nearests = map (`KDM.nearest` query) ts in if Data.List.null nearests- then error "Called nearestNeighbor on empty KdMap."+ then error "Called nearest on empty KdMap." else L.minimumBy (compare `on` (d2 query . fst)) nearests -insertPair :: Real a => KdMap a p v -> (p, v) -> KdMap a p v-insertPair t = uncurry (insert t)- -- | Given a 'KdMap', a query point, and a number @k@, returns the -- @k@ point-value pairs with the nearest points to the query. --@@ -165,9 +172,9 @@ -- -- Worst case time complexity: /n * log(k)/ for /k/ nearest neighbors -- on a structure with /n/ data points.-kNearestNeighbors :: Real a => KdMap a p v -> Int -> p -> [(p, v)]-kNearestNeighbors (KdMap trees _ d2 _) k query =- let neighborSets = map (\t -> KDM.kNearestNeighbors t k query) trees+kNearest :: Real a => KdMap a p v -> Int -> p -> [(p, v)]+kNearest (KdMap trees _ d2 _) k query =+ let neighborSets = map (\t -> KDM.kNearest t k query) trees in take k $ L.foldr merge [] neighborSets where merge [] ys = ys merge xs [] = xs@@ -184,9 +191,9 @@ -- Points are not returned in any particular order. -- -- Worst case time complexity: /O(n)/ for /n/ data points.-pointsInRadius :: Real a => KdMap a p v -> a -> p -> [(p, v)]-pointsInRadius (KdMap trees _ _ _) radius query =- L.concatMap (\t -> KDM.pointsInRadius t radius query) trees+inRadius :: Real a => KdMap a p v -> a -> p -> [(p, v)]+inRadius (KdMap trees _ _ _) radius query =+ L.concatMap (\t -> KDM.inRadius t radius query) trees -- | Finds all point-value pairs in a 'KdMap' with points within a -- given range, where the range is specified as a set of lower and@@ -196,13 +203,13 @@ -- -- Worst case time complexity: /O(n)/ for n data points and a range -- that spans all the points.-pointsInRange :: Real a => KdMap a p v- -> p -- ^ lower bounds of range- -> p -- ^ upper bounds of range- -> [(p, v)] -- ^ point-value pairs within- -- given range-pointsInRange (KdMap trees _ _ _) lowers uppers =- L.concatMap (\t -> KDM.pointsInRange t lowers uppers) trees+inRange :: Real a => KdMap a p v+ -> p -- ^ lower bounds of range+ -> p -- ^ upper bounds of range+ -> [(p, v)] -- ^ point-value pairs within given+ -- range+inRange (KdMap trees _ _ _) lowers uppers =+ L.concatMap (\t -> KDM.inRange t lowers uppers) trees -- | Returns the number of elements in the 'KdMap'. --@@ -219,118 +226,23 @@ -- | Returns all points in the 'KdMap'. -- -- Time complexity: /O(n)/ for /n/ data points.-points :: KdMap a p v -> [p]-points = map fst . assocs+keys :: KdMap a p v -> [p]+keys = map fst . assocs -- | Returns all values in the 'KdMap'. -- -- Time complexity: /O(n)/ for /n/ data points.-values :: KdMap a p v -> [v]-values = map snd . assocs+elems :: KdMap a p v -> [v]+elems = map snd . assocs -- | Inserts a list of point-value pairs into the 'KdMap'.+--+-- TODO: This will be made far more efficient than simply repeatedly+-- inserting. batchInsert :: Real a => KdMap a p v -> [(p, v)] -> KdMap a p v--- TODO: This can be made far more efficient by batch-creating the--- individual KdMaps before placing them into the KdMap batchInsert = L.foldl' insertPair ------------------------------------------------------------------------------------ Tests-----------------------------------------------------------------------------------testElements :: [p] -> [(p, Int)]-testElements ps = zip ps [1 ..]--checkLogNTrees :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> [p] -> Bool-checkLogNTrees p2l d2 ps =- let lengthIsLogN (KdMap ts _ _ n) = length ts == popCount n- in L.all lengthIsLogN $ scanl insertPair (emptyKdMapWithDistFn p2l d2) $ testElements ps--prop_logNTrees :: [Point2d] -> Bool-prop_logNTrees = checkLogNTrees pointAsList2d distSqr2d--checkTreeSizesPowerOf2 :: Real a => PointAsListFn a p ->- SquaredDistanceFn a p ->- [p] ->- Bool-checkTreeSizesPowerOf2 p2l d2 ps =- let sizesPowerOf2 (KdMap ts _ _ _) = L.all (== 1) $ map (popCount . length . KDM.assocs) ts- in L.all sizesPowerOf2 $ scanl insertPair (emptyKdMapWithDistFn p2l d2) $ testElements ps--prop_treeSizesPowerOf2 :: [Point2d] -> Bool-prop_treeSizesPowerOf2 = checkTreeSizesPowerOf2 pointAsList2d distSqr2d--checkNumElements :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> [p] -> Bool-checkNumElements p2l d2 ps =- let numsMatch (num, KdMap ts _ _ n) = n == num && n == L.sum (map (length . KDM.assocs) ts)- in L.all numsMatch $ zip [0..] $ scanl insertPair (emptyKdMapWithDistFn p2l d2) $ testElements ps--prop_validNumElements :: [Point2d] -> Bool-prop_validNumElements = checkNumElements pointAsList2d distSqr2d--checkNearestEqualToBatch :: (Eq p, Real a) => PointAsListFn a p ->- SquaredDistanceFn a p ->- ([p], p) ->- Bool-checkNearestEqualToBatch p2l d2 (ps, query) =- let kdt = KDM.buildKdMapWithDistFn p2l d2 $ testElements ps- kdtAnswer = KDM.nearestNeighbor kdt query- dkdt = batchInsert (emptyKdMapWithDistFn p2l d2) $ testElements ps- dkdtAnswer = nearestNeighbor dkdt query- in dkdtAnswer == kdtAnswer--prop_nearestEqualToBatch :: Point2d -> Property-prop_nearestEqualToBatch query =- forAll (listOf1 arbitrary) $ \xs ->- checkNearestEqualToBatch pointAsList2d distSqr2d (xs, query)--checkKNearestEqualToBatch :: (Eq p, Real a) => PointAsListFn a p ->- SquaredDistanceFn a p ->- ([p], Int, p) ->- Bool-checkKNearestEqualToBatch p2l d2 (ps, k, query) =- let kdt = KDM.buildKdMapWithDistFn p2l d2 $ testElements ps- kdtAnswer = KDM.kNearestNeighbors kdt k query- dkdt = batchInsert (emptyKdMapWithDistFn p2l d2) $ testElements ps- dkdtAnswer = kNearestNeighbors dkdt k query- in dkdtAnswer == kdtAnswer--prop_kNearestEqualToBatch :: Point2d -> Property-prop_kNearestEqualToBatch query =- forAll (listOf1 arbitrary) $ \xs ->- forAll (choose (1, length xs)) $ \k ->- checkKNearestEqualToBatch pointAsList2d distSqr2d (xs, k, query)--checkInRadiusEqualToBatch :: (Ord p, Real a) => PointAsListFn a p ->- SquaredDistanceFn a p ->- ([p], a, p) ->- Bool-checkInRadiusEqualToBatch p2l d2 (ps, radius, query) =- let kdt = KDM.buildKdMapWithDistFn p2l d2 $ testElements ps- kdtAnswer = KDM.pointsInRadius kdt radius query- dkdt = batchInsert (emptyKdMapWithDistFn p2l d2) $ testElements ps- dkdtAnswer = pointsInRadius dkdt radius query- in sort dkdtAnswer == sort kdtAnswer--prop_checkInRadiusEqualToBatch :: Point2d -> Property-prop_checkInRadiusEqualToBatch query =- forAll (listOf1 arbitrary) $ \xs ->- forAll (choose (0.0, 1000.0)) $ \radius ->- checkInRadiusEqualToBatch pointAsList2d distSqr2d (xs, radius, query)--prop_checkInRangeEqualToBatch :: ([Point2d], Point2d, Point2d) -> Bool-prop_checkInRangeEqualToBatch ([], _, _) = True-prop_checkInRangeEqualToBatch (xs, lowers, uppers)- | L.and $ zipWith (<) (pointAsList2d lowers) (pointAsList2d uppers) =- let kdt = KDM.buildKdMapWithDistFn pointAsList2d distSqr2d $ testElements xs- kdtAnswer = KDM.pointsInRange kdt lowers uppers- dkdt = batchInsert (emptyKdMapWithDistFn pointAsList2d distSqr2d) $ testElements xs- dkdtAnswer = pointsInRange dkdt lowers uppers- in sort dkdtAnswer == sort kdtAnswer- | otherwise = True----- Run all tests-return []-runTests :: IO Bool-runTests = $quickCheckAll+-- | Returns size of each internal /k/-d tree that makes up the+-- dynamic structure. For internal testing use.+subtreeSizes :: KdMap a p v -> [Int]+subtreeSizes (KdMap trees _ _ _) = map KDM.size trees
lib-src/Data/KdMap/Static.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-} module Data.KdMap.Static ( -- * Usage@@ -12,40 +12,45 @@ , SquaredDistanceFn , KdMap -- ** /k/-d map construction- , buildKdMap- , buildKdMapWithDistFn+ , empty+ , emptyWithDist+ , singleton+ , singletonWithDist+ , build+ , buildWithDist+ , insertUnbalanced+ , batchInsertUnbalanced -- ** Query- , nearestNeighbor- , pointsInRadius- , kNearestNeighbors- , pointsInRange+ , nearest+ , inRadius+ , kNearest+ , inRange , assocs- , points- , values+ , keys+ , elems+ , null , size -- ** Folds- , foldrKdMap+ , foldrWithKey -- ** Utilities- , defaultDistSqrFn- , runTests+ , defaultSqrDist+ -- ** Internal (for testing)+ , isValid ) where import Control.DeepSeq import Control.DeepSeq.Generics (genericRnf) import GHC.Generics -import Control.Applicative+import Control.Applicative hiding (empty) import Data.Foldable-import Data.Function+import Prelude hiding (null) import qualified Data.List as L import Data.Maybe import Data.Ord import qualified Data.PQueue.Prio.Max as Q import Data.Traversable-import Test.QuickCheck -import Data.Point2d- -- $usage -- -- The 'KdMap' is a variant of 'Data.KdTree.Static.KdTree' where each point in@@ -53,7 +58,7 @@ -- we'll refer to the points and their associated data as the /points/ -- and /values/ of the 'KdMap', respectively. It might help to think -- of 'Data.KdTree.Static.KdTree' and 'KdMap' as being analogous to--- 'Data.Set' and 'Data.Map'.+-- 'Set' and 'Map'. -- -- Suppose you wanted to perform point queries on a set of 3D points, -- where each point is associated with a 'String'. Here's how to build@@ -66,11 +71,11 @@ -- -- >>> let valueStrings = [\"First\", \"Second\"] ----- >>> let pointValuePairs = zip points valueStrings+-- >>> let pointValuePairs = 'zip' points valueStrings ----- >>> let kdm = buildKdMap point3dAsList pointValuePairs+-- >>> let kdm = 'build' point3dAsList pointValuePairs ----- >>> nearestNeighbor kdm (Point3d 0.1 0.1 0.1)+-- >>> 'nearest' kdm (Point3d 0.1 0.1 0.1) -- [Point3d {x = 0.0, y = 0.0, z = 0.0}, \"First\"] -- @ @@ -80,7 +85,7 @@ , _treeRight :: TreeNode a p v } | Empty- deriving Generic+ deriving (Generic, Show, Read) instance (NFData a, NFData p, NFData v) => NFData (TreeNode a p v) where rnf = genericRnf mapTreeNode :: (v1 -> v2) -> TreeNode a p v1 -> TreeNode a p v2@@ -106,6 +111,9 @@ } deriving Generic instance (NFData a, NFData p, NFData v) => NFData (KdMap a p v) where rnf = genericRnf +instance (Show a, Show p, Show v) => Show (KdMap a p v) where+ show (KdMap _ _ rootNode _) = "KdMap " ++ show rootNode+ instance Functor (KdMap a p) where fmap f kdMap = kdMap { _rootNode = mapTreeNode f (_rootNode kdMap) } @@ -115,11 +123,11 @@ foldrTreeNode f (f p (foldrTreeNode f z right)) left -- | Performs a foldr over each point-value pair in the 'KdMap'.-foldrKdMap :: ((p, v) -> b -> b) -> b -> KdMap a p v -> b-foldrKdMap f z (KdMap _ _ r _) = foldrTreeNode f z r+foldrWithKey :: ((p, v) -> b -> b) -> b -> KdMap a p v -> b+foldrWithKey f z (KdMap _ _ r _) = foldrTreeNode f z r instance Foldable (KdMap a p) where- foldr f = foldrKdMap (f . snd)+ foldr f = foldrWithKey (f . snd) traverseTreeNode :: Applicative f => (b -> f c) -> TreeNode a p b -> f (TreeNode a p c) traverseTreeNode _ Empty = pure Empty@@ -136,6 +144,35 @@ traverse f (KdMap p d r n) = KdMap <$> pure p <*> pure d <*> traverseTreeNode f r <*> pure n +-- | Builds an empty 'KdMap'.+empty :: Real a => PointAsListFn a p -> KdMap a p v+empty p2l = emptyWithDist p2l (defaultSqrDist p2l)++-- | Builds an empty 'KdMap' using a user-specified squared distance+-- function.+emptyWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> KdMap a p v+emptyWithDist p2l d2 = KdMap p2l d2 Empty 0++-- | Returns 'True' if the given 'KdMap' is empty.+null :: KdMap a p v -> Bool+null kdm = _size kdm == 0++-- | Builds a 'KdMap' with a single point-value pair and a+-- user-specified squared distance function.+singletonWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> (p, v)+ -> KdMap a p v+singletonWithDist p2l d2 (p, v) =+ let singletonTreeNode = TreeNode Empty (p, v) (head $ p2l p) Empty+ in KdMap p2l d2 singletonTreeNode 1++-- | Builds a 'KdMap' with a single point-value pair.+singleton :: Real a => PointAsListFn a p -> (p, v) -> KdMap a p v+singleton p2l (p, v) = singletonWithDist p2l (defaultSqrDist p2l) (p, v)+ quickselect :: (b -> b -> Ordering) -> Int -> [b] -> b quickselect cmp = go where go _ [] = error "quickselect must be called on a non-empty list."@@ -154,14 +191,12 @@ -- Worst case time complexity: /O(n^2)/ for /n/ data points. -- -- Worst case space complexity: /O(n)/ for /n/ data points.------ Throws an error if given an empty list of data points.-buildKdMapWithDistFn :: Real a => PointAsListFn a p ->- SquaredDistanceFn a p ->- [(p, v)] ->- KdMap a p v-buildKdMapWithDistFn _ _ [] = error "KdMap must be built with a non-empty list."-buildKdMapWithDistFn pointAsList distSqr dataPoints =+buildWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> [(p, v)]+ -> KdMap a p v+buildWithDist p2l d2 [] = emptyWithDist p2l d2+buildWithDist pointAsList distSqr dataPoints = let axisValsPointsPairs = zip (map (cycle . pointAsList . fst) dataPoints) dataPoints in KdMap { _pointAsList = pointAsList , _distSqr = distSqr@@ -191,25 +226,53 @@ -- | A default implementation of squared distance given two points and -- a 'PointAsListFn'.-defaultDistSqrFn :: Num a => PointAsListFn a p -> SquaredDistanceFn a p-defaultDistSqrFn pointAsList k1 k2 =+defaultSqrDist :: Num a => PointAsListFn a p -> SquaredDistanceFn a p+defaultSqrDist pointAsList k1 k2 = L.sum $ map (^ (2 :: Int)) $ zipWith (-) (pointAsList k1) (pointAsList k2) -- | Builds a 'KdTree' from a list of pairs of points (of type p) and -- values (of type v) using a default squared distance function--- 'defaultDistSqrFn'.+-- 'defaultSqrDist'. -- -- Average complexity: /O(n * log(n))/ for /n/ data points. -- -- Worst case time complexity: /O(n^2)/ for /n/ data points. -- -- Worst case space complexity: /O(n)/ for /n/ data points.+build :: Real a => PointAsListFn a p -> [(p, v)] -> KdMap a p v+build pointAsList =+ buildWithDist pointAsList $ defaultSqrDist pointAsList++-- | Inserts a point-value pair into a 'KdMap'. This can potentially+-- cause the internal tree structure to become unbalanced. If the tree+-- becomes too unbalanced, point queries will be very inefficient. If+-- you need to perform lots of point insertions on an already existing+-- /k/-d map, check out+-- @Data.KdMap.Dynamic.@'Data.KdMap.Dynamic.KdMap'. ----- Throws an error if given an empty list of data points.-buildKdMap :: Real a => PointAsListFn a p -> [(p, v)] -> KdMap a p v-buildKdMap pointAsList =- buildKdMapWithDistFn pointAsList $ defaultDistSqrFn pointAsList+-- Average complexity: /O(log(n))/ for /n/ data points.+--+-- Worst case time complexity: /O(n)/ for /n/ data points.+insertUnbalanced :: Real a => KdMap a p v -> p -> v -> KdMap a p v+insertUnbalanced kdm@(KdMap pointAsList _ rootNode n) p' v' =+ kdm { _rootNode = go rootNode (cycle $ pointAsList p'), _size = n + 1 }+ where+ go _ [] = error "insertUnbalanced.go: no empty lists allowed!"+ go Empty (axisValue' : _) = TreeNode Empty (p', v') axisValue' Empty+ go t@(TreeNode left _ nodeAxisValue right) (axisValue' : nextAxisValues)+ | axisValue' <= nodeAxisValue = t { _treeLeft = go left nextAxisValues }+ | otherwise = t { _treeRight = go right nextAxisValues } +-- | Inserts a list of point-value pairs into a 'KdMap'. This can+-- potentially cause the internal tree structure to become unbalanced,+-- which leads to inefficient point queries.+--+-- Average complexity: /O(n * log(n))/ for /n/ data points.+--+-- Worst case time complexity: /O(n^2)/ for /n/ data points.+batchInsertUnbalanced :: Real a => KdMap a p v -> [(p, v)] -> KdMap a p v+batchInsertUnbalanced = foldl' $ \kdm (p, v) -> insertUnbalanced kdm p v+ assocsInternal :: TreeNode a p v -> [(p, v)] assocsInternal t = go t [] where go Empty = id@@ -224,14 +287,14 @@ -- | Returns all points in the 'KdMap'. -- -- Time complexity: /O(n)/ for /n/ data points.-points :: KdMap a p v -> [p]-points = map fst . assocs+keys :: KdMap a p v -> [p]+keys = map fst . assocs -- | Returns all values in the 'KdMap'. -- -- Time complexity: /O(n)/ for /n/ data points.-values :: KdMap a p v -> [v]-values = map snd . assocs+elems :: KdMap a p v -> [v]+elems = map snd . assocs -- | Given a 'KdMap' and a query point, returns the point-value pair -- in the 'KdMap' with the point nearest to the query.@@ -239,15 +302,17 @@ -- Average time complexity: /O(log(n))/ for /n/ data points. -- -- Worst case time complexity: /O(n)/ for /n/ data points.-nearestNeighbor :: Real a => KdMap a p v -> p -> (p, v)-nearestNeighbor (KdMap _ _ Empty _) _ =- error "nearestNeighbor: why is there an empty KdMap?"-nearestNeighbor (KdMap pointAsList distSqr t@(TreeNode _ root _ _) _) query =+--+-- Throws error if called on an empty 'KdMap'.+nearest :: Real a => KdMap a p v -> p -> (p, v)+nearest (KdMap _ _ Empty _) _ =+ error "Attempted to call nearest on an empty KdMap."+nearest (KdMap pointAsList distSqr t@(TreeNode _ root _ _) _) query = -- This is an ugly way to kickstart the function but it's faster -- than using a Maybe. fst $ go (root, distSqr (fst root) query) (cycle $ pointAsList query) t where- go _ [] _ = error "nearestNeighbor.go: no empty lists allowed!"+ go _ [] _ = error "nearest.go: no empty lists allowed!" go bestSoFar _ Empty = bestSoFar go bestSoFar (queryAxisValue : qvs)@@ -276,16 +341,15 @@ -- -- Worst case time complexity: /O(n)/ for /n/ data points and a radius -- that spans all points in the structure.-pointsInRadius :: Real a => KdMap a p v- -> a -- ^ radius- -> p -- ^ query point- -> [(p, v)] -- ^ list of point-value pairs- -- with points within given- -- radius of query-pointsInRadius (KdMap pointAsList distSqr t _) radius query =+inRadius :: Real a => KdMap a p v+ -> a -- ^ radius+ -> p -- ^ query point+ -> [(p, v)] -- ^ list of point-value pairs with+ -- points within given radius of query+inRadius (KdMap pointAsList distSqr t _) radius query = go (cycle $ pointAsList query) t [] where- go [] _ _ = error "pointsInRadius.go: no empty lists allowed!"+ go [] _ _ = error "inRadius.go: no empty lists allowed!" go _ Empty acc = acc go (queryAxisValue : qvs) (TreeNode left (k, v) nodeAxisVal right) acc = let onTheLeft = queryAxisValue <= nodeAxisVal@@ -313,12 +377,12 @@ -- -- Worst case time complexity: /n * log(k)/ for /k/ nearest -- neighbors on a structure with /n/ data points.-kNearestNeighbors :: Real a => KdMap a p v -> Int -> p -> [(p, v)]-kNearestNeighbors (KdMap pointAsList distSqr t _) numNeighbors query =+kNearest :: Real a => KdMap a p v -> Int -> p -> [(p, v)]+kNearest (KdMap pointAsList distSqr t _) numNeighbors query = reverse $ map snd $ Q.toList $ go (cycle $ pointAsList query) Q.empty t where -- go :: [Double] -> Q.MaxPQueue Double (p, d) -> TreeNode p d -> KQueue p d- go [] _ _ = error "kNearestNeighbors.go: no empty lists allowed!"+ go [] _ _ = error "kNearest.go: no empty lists allowed!" go _ q Empty = q go (queryAxisValue : qvs) q (TreeNode left (k, v) nodeAxisVal right) = let insertBounded queue dist x@@ -327,7 +391,7 @@ then Q.insert dist x $ Q.deleteMax queue else queue q' = insertBounded q (distSqr k query) (k, v)- kNearest queue onsideSubtree offsideSubtree =+ kNear queue onsideSubtree offsideSubtree = let queue' = go qvs queue onsideSubtree checkOffsideTree = Q.size queue' < numNeighbors ||@@ -336,8 +400,8 @@ then go qvs queue' offsideSubtree else queue' in if queryAxisValue <= nodeAxisVal- then kNearest q' left right- else kNearest q' right left+ then kNear q' left right+ else kNear q' right left -- | Finds all point-value pairs in a 'KdMap' with points within a -- given range, where the range is specified as a set of lower and@@ -351,15 +415,15 @@ -- TODO: Maybe use known bounds on entire tree structure to be able to -- automatically count whole portions of tree as being within given -- range.-pointsInRange :: Real a => KdMap a p v- -> p -- ^ lower bounds of range- -> p -- ^ upper bounds of range- -> [(p, v)] -- ^ point-value pairs within- -- given range-pointsInRange (KdMap pointAsList _ t _) lowers uppers =+inRange :: Real a => KdMap a p v+ -> p -- ^ lower bounds of range+ -> p -- ^ upper bounds of range+ -> [(p, v)] -- ^ point-value pairs within given+ -- range+inRange (KdMap pointAsList _ t _) lowers uppers = go (cycle (pointAsList lowers) `zip` cycle (pointAsList uppers)) t [] where- go [] _ _ = error "neighborsInRange.go: no empty lists allowed!"+ go [] _ _ = error "inRange.go: no empty lists allowed!" go _ Empty acc = acc go ((lower, upper) : nextBounds) (TreeNode left p nodeAxisVal right) acc = let accAfterLeft = if lower <= nodeAxisVal@@ -386,138 +450,17 @@ size :: KdMap a p v -> Int size (KdMap _ _ _ n) = n ------------------------------------------------------------------------------------ Tests-----------------------------------------------------------------------------------testElements :: [p] -> [(p, Int)]-testElements ps = zip ps [0 ..]--isTreeValid :: Real a => PointAsListFn a p -> Int -> TreeNode a p v -> Bool-isTreeValid _ _ Empty = True-isTreeValid pointAsList axis (TreeNode l (k, _) nodeAxisVal r) =+isTreeNodeValid :: Real a => PointAsListFn a p -> Int -> TreeNode a p v -> Bool+isTreeNodeValid _ _ Empty = True+isTreeNodeValid pointAsList axis (TreeNode l (k, _) nodeAxisVal r) = let childrenAxisValues = map ((!! axis) . pointAsList . fst) . assocsInternal leftSubtreeLess = L.all (<= nodeAxisVal) $ childrenAxisValues l rightSubtreeGreater = L.all (> nodeAxisVal) $ childrenAxisValues r nextAxis = (axis + 1) `mod` length (pointAsList k) in leftSubtreeLess && rightSubtreeGreater &&- isTreeValid pointAsList nextAxis l && isTreeValid pointAsList nextAxis r--checkValidTree :: Real a => PointAsListFn a p -> [p] -> Bool-checkValidTree pointAsList ps =- let (KdMap _ _ r _) = buildKdMap pointAsList $ testElements ps- in isTreeValid pointAsList 0 r--prop_validTree :: Property-prop_validTree = forAll (listOf1 arbitrary) $ checkValidTree pointAsList2d--checkElements :: (Ord p, Real a) => PointAsListFn a p -> [p] -> Bool-checkElements pointAsList ps =- let kdt = buildKdMap pointAsList $ testElements ps- in L.sort (assocs kdt) == L.sort (testElements ps)--prop_sameElements :: Property-prop_sameElements = forAll (listOf1 arbitrary) $ checkElements pointAsList2d--checkNumElements :: Real a => PointAsListFn a p -> [p] -> Bool-checkNumElements pointAsList ps =- let (KdMap _ _ _ n) = buildKdMap pointAsList $ testElements ps- in n == length ps--prop_validNumElements :: Property-prop_validNumElements = forAll (listOf1 arbitrary) $ checkNumElements pointAsList2d--nearestNeighborLinear :: Real a => PointAsListFn a p -> [(p, v)] -> p -> (p, v)-nearestNeighborLinear pointAsList xs query =- L.minimumBy (compare `on` (defaultDistSqrFn pointAsList query . fst)) xs--checkNearestEqualToLinear :: (Eq p, Real a) => PointAsListFn a p -> ([p], p) -> Bool-checkNearestEqualToLinear pointAsList (ps, query) =- let kdt = buildKdMap pointAsList $ testElements ps- in nearestNeighbor kdt query == nearestNeighborLinear pointAsList (testElements ps) query--prop_nearestEqualToLinear :: Point2d -> Property-prop_nearestEqualToLinear query =- forAll (listOf1 arbitrary) $ \xs ->- checkNearestEqualToLinear pointAsList2d (xs, query)--pointsInRadiusLinear :: Real a => PointAsListFn a p -> [(p, v)] -> p -> a -> [(p, v)]-pointsInRadiusLinear pointAsList xs query radius =- filter ((<= radius * radius) . defaultDistSqrFn pointAsList query . fst) xs--checkInRadiusEqualToLinear :: (Ord p, Real a) => PointAsListFn a p -> a -> ([p], p) -> Bool-checkInRadiusEqualToLinear pointAsList radius (ps, query) =- let kdt = buildKdMap pointAsList $ testElements ps- kdtNear = pointsInRadius kdt radius query- linearNear = pointsInRadiusLinear pointAsList (testElements ps) query radius- in L.sort kdtNear == L.sort linearNear--prop_inRadiusEqualToLinear :: Point2d -> Property-prop_inRadiusEqualToLinear query =- forAll (listOf1 arbitrary) $ \xs ->- forAll (choose (0.0, 1000.0)) $ \radius ->- checkInRadiusEqualToLinear pointAsList2d radius (xs, query)--kNearestNeighborsLinear :: Real a => PointAsListFn a p -> [(p, v)] -> p -> Int -> [(p, v)]-kNearestNeighborsLinear pointAsList xs query k =- take k $ L.sortBy (compare `on` (defaultDistSqrFn pointAsList query . fst)) xs--checkKNearestEqualToLinear :: (Ord p, Real a) => PointAsListFn a p -> Int -> ([p], p) -> Bool-checkKNearestEqualToLinear pointAsList k (xs, query) =- let kdt = buildKdMap pointAsList $ testElements xs- kdtKNear = kNearestNeighbors kdt k query- linearKNear = kNearestNeighborsLinear pointAsList (testElements xs) query k- in kdtKNear == linearKNear--prop_kNearestEqualToLinear :: Point2d -> Property-prop_kNearestEqualToLinear query =- forAll (listOf1 arbitrary) $ \xs ->- forAll (choose (1, length xs)) $ \k ->- checkKNearestEqualToLinear pointAsList2d k (xs, query)--checkKNearestSorted :: (Eq p, Real a) => PointAsListFn a p -> ([p], p) -> Bool-checkKNearestSorted _ ([], _) = True-checkKNearestSorted pointAsList (ps, query) =- let kdt = buildKdMap pointAsList $ testElements ps- kNearestDists =- map (defaultDistSqrFn pointAsList query . fst) $ kNearestNeighbors kdt (length ps) query- in kNearestDists == L.sort kNearestDists--prop_kNearestSorted :: Point2d -> Property-prop_kNearestSorted query =- forAll (listOf1 arbitrary) $ \xs ->- checkKNearestSorted pointAsList2d (xs, query)--rangeLinear :: Real a => PointAsListFn a p -> [(p, v)] -> p -> p -> [(p, v)]-rangeLinear pointAsList xs lowers uppers =- let valInRange a lower upper = lower <= a && a <= upper- lowersAsList = pointAsList lowers- uppersAsList = pointAsList uppers- pointInRange (p, _) =- L.and $ zipWith3 valInRange (pointAsList p) lowersAsList uppersAsList- in filter pointInRange xs--prop_rangeEqualToLinear :: ([Point2d], Point2d, Point2d) -> Bool-prop_rangeEqualToLinear (xs, lowers, uppers)- | null xs = True- | L.and $ zipWith (<) (pointAsList2d lowers) (pointAsList2d uppers) =- let linear = rangeLinear pointAsList2d (testElements xs) lowers uppers- kdt = buildKdMap pointAsList2d $ testElements xs- kdtPoints = pointsInRange kdt lowers uppers- in L.sort linear == L.sort kdtPoints- | otherwise = True--prop_equalAxisValueSameElems :: Property-prop_equalAxisValueSameElems =- forAll (listOf1 arbitrary) $ \xs@(Point2d x y : _) ->- checkElements pointAsList2d $ Point2d x (y + 1) : xs--prop_equalAxisValueEqualToLinear :: Point2d -> Property-prop_equalAxisValueEqualToLinear query =- forAll (listOf1 arbitrary) $ \xs@(Point2d x y : _) ->- checkNearestEqualToLinear pointAsList2d (Point2d x (y + 1) : xs, query)+ isTreeNodeValid pointAsList nextAxis l && isTreeNodeValid pointAsList nextAxis r --- Run all tests-return []-runTests :: IO Bool-runTests = $quickCheckAll+-- | Returns 'True' if tree structure adheres to k-d tree+-- properties. For internal testing use.+isValid :: Real a => KdMap a p v -> Bool+isValid (KdMap pointAsList _ r _) = isTreeNodeValid pointAsList 0 r
lib-src/Data/KdTree/Dynamic.hs view
@@ -10,30 +10,30 @@ , SquaredDistanceFn , KdTree -- ** Dynamic /k/-d tree construction- , emptyKdTree+ , empty , singleton- , emptyKdTreeWithDistFn- , singletonWithDistFn+ , emptyWithDist+ , singletonWithDist -- ** Insertion , insert -- ** Query- , nearestNeighbor- , pointsInRadius- , kNearestNeighbors- , pointsInRange- , points+ , nearest+ , inRadius+ , kNearest+ , inRange+ , toList , null , size -- ** Utilities- , defaultDistSqrFn+ , defaultSqrDist ) where import Prelude hiding (null) -import Data.Foldable+import qualified Data.Foldable as F import qualified Data.KdMap.Dynamic as DKDM-import Data.KdMap.Dynamic (PointAsListFn, SquaredDistanceFn, defaultDistSqrFn)+import Data.KdMap.Dynamic (PointAsListFn, SquaredDistanceFn, defaultSqrDist) -- $usage --@@ -47,36 +47,39 @@ -- queries using 'KdTree': -- -- @--- >>> let dkdt = singleton point3dAsList (Point3D 0.0 0.0 0.0)+-- >>> let dkdt = 'singleton' point3dAsList (Point3D 0.0 0.0 0.0) ----- >>> let dkdt' = insert dkdt (Point3D 1.0 1.0 1.0)+-- >>> let dkdt' = 'insert' dkdt (Point3D 1.0 1.0 1.0) ----- >>> nearestNeighbor dkdt' (Point3D 0.4 0.4 0.4)+-- >>> 'nearest' dkdt' (Point3D 0.4 0.4 0.4) -- Point3D {x = 0.0, y = 0.0, z = 0.0} ----- >>> let dkdt'' = insert dkdt' (Point3D 0.5 0.5 0.5)+-- >>> let dkdt'' = 'insert' dkdt' (Point3D 0.5 0.5 0.5) ----- >>> nearestNeighbor dkdt'' (Point3D 0.4 0.4 0.4)+-- >>> 'nearest' dkdt'' (Point3D 0.4 0.4 0.4) -- Point3D {x = 0.5, y = 0.5, z = 0.5} -- @ ----- Check out @Data.KdMap.Dynamic.@'Data.KdMap.Dynamic.KdMap' if you want to associate a value--- with each point in your tree structure.+-- Check out @Data.KdMap.Dynamic.@'Data.KdMap.Dynamic.KdMap' if you+-- want to associate a value with each point in your tree structure. -- | A dynamic /k/-d tree structure that stores points of type @p@ -- with axis values of type @a@. newtype KdTree a p = KdTree (DKDM.KdMap a p ()) -instance Foldable (KdTree a) where- foldr f z (KdTree dkdMap) = DKDM.foldrKdMap (f . fst) z dkdMap+instance F.Foldable (KdTree a) where+ foldr f z (KdTree dkdMap) = DKDM.foldrWithKey (f . fst) z dkdMap +instance (Show a, Show p) => Show (KdTree a p) where+ show (KdTree kdm) = "KdTree " ++ show kdm+ -- | Generates an empty 'KdTree' with a user-specified distance function.-emptyKdTreeWithDistFn :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> KdTree a p-emptyKdTreeWithDistFn p2l d2 = KdTree $ DKDM.emptyKdMapWithDistFn p2l d2+emptyWithDist :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> KdTree a p+emptyWithDist p2l d2 = KdTree $ DKDM.emptyWithDist p2l d2 -- | Generates an empty 'KdTree' with the default distance function.-emptyKdTree :: Real a => PointAsListFn a p -> KdTree a p-emptyKdTree p2l = emptyKdTreeWithDistFn p2l $ defaultDistSqrFn p2l+empty :: Real a => PointAsListFn a p -> KdTree a p+empty p2l = emptyWithDist p2l $ defaultSqrDist p2l -- | Returns whether the 'KdTree' is empty. null :: KdTree a p -> Bool@@ -84,13 +87,16 @@ -- | Generates a 'KdTree' with a single point using a -- user-specified distance function.-singletonWithDistFn :: Real a => PointAsListFn a p -> SquaredDistanceFn a p -> p -> KdTree a p-singletonWithDistFn p2l d2 p = KdTree $ DKDM.singletonWithDistFn p2l d2 (p, ())+singletonWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> p+ -> KdTree a p+singletonWithDist p2l d2 p = KdTree $ DKDM.singletonWithDist p2l d2 (p, ()) -- | Generates a 'KdTree' with a single point using the default -- distance function. singleton :: Real a => PointAsListFn a p -> p -> KdTree a p-singleton p2l = singletonWithDistFn p2l $ defaultDistSqrFn p2l+singleton p2l = singletonWithDist p2l $ defaultSqrDist p2l -- | Adds a given point to a 'KdTree'. --@@ -102,8 +108,8 @@ -- in the 'KdTree' to the query point. -- -- Average time complexity: /O(log^2(n))/.-nearestNeighbor :: Real a => KdTree a p -> p -> p-nearestNeighbor (KdTree dkdMap) = fst . DKDM.nearestNeighbor dkdMap+nearest :: Real a => KdTree a p -> p -> p+nearest (KdTree dkdMap) = fst . DKDM.nearest dkdMap -- | Given a 'KdTree', a query point, and a number @k@, returns the -- @k@ nearest points in the 'KdTree' to the query point.@@ -116,9 +122,9 @@ -- -- Worst case time complexity: /n * log(k)/ for /k/ nearest neighbors -- on a structure with /n/ data points.-kNearestNeighbors :: Real a => KdTree a p -> Int -> p -> [p]-kNearestNeighbors (KdTree dkdMap) k query =- map fst $ DKDM.kNearestNeighbors dkdMap k query+kNearest :: Real a => KdTree a p -> Int -> p -> [p]+kNearest (KdTree dkdMap) k query =+ map fst $ DKDM.kNearest dkdMap k query -- | Given a 'KdTree', a query point, and a radius, returns all -- points in the 'KdTree' that are within the given radius of the@@ -127,9 +133,9 @@ -- Points are not returned in any particular order. -- -- Worst case time complexity: /O(n)/ for /n/ data points.-pointsInRadius :: Real a => KdTree a p -> a -> p -> [p]-pointsInRadius (KdTree dkdMap) radius query =- map fst $ DKDM.pointsInRadius dkdMap radius query+inRadius :: Real a => KdTree a p -> a -> p -> [p]+inRadius (KdTree dkdMap) radius query =+ map fst $ DKDM.inRadius dkdMap radius query -- | Finds all points in a 'KdTree' with points within a given range, -- where the range is specified as a set of lower and upper bounds.@@ -138,12 +144,12 @@ -- -- Worst case time complexity: /O(n)/ for n data points and a range -- that spans all the points.-pointsInRange :: Real a => KdTree a p- -> p -- ^ lower bounds of range- -> p -- ^ upper bounds of range- -> [p] -- ^ all points within given range-pointsInRange (KdTree dkdMap) lowers uppers =- map fst $ DKDM.pointsInRange dkdMap lowers uppers+inRange :: Real a => KdTree a p+ -> p -- ^ lower bounds of range+ -> p -- ^ upper bounds of range+ -> [p] -- ^ all points within given range+inRange (KdTree dkdMap) lowers uppers =+ map fst $ DKDM.inRange dkdMap lowers uppers -- | Returns the number of elements in the 'KdTree'. --@@ -154,5 +160,5 @@ -- | Returns a list of all the points in the 'KdTree'. -- -- Time complexity: /O(n)/-points :: KdTree a p -> [p]-points (KdTree dkdMap) = DKDM.points dkdMap+toList :: KdTree a p -> [p]+toList (KdTree dkdMap) = DKDM.keys dkdMap
lib-src/Data/KdTree/Static.hs view
@@ -36,27 +36,35 @@ , SquaredDistanceFn , KdTree -- ** /k/-d tree construction- , buildKdTree- , buildKdTreeWithDistFn+ , empty+ , emptyWithDist+ , singleton+ , singletonWithDist+ , build+ , buildWithDist+ , insertUnbalanced+ , batchInsertUnbalanced -- ** Query- , nearestNeighbor- , pointsInRadius- , kNearestNeighbors- , points- , pointsInRange+ , nearest+ , inRadius+ , kNearest+ , inRange+ , toList+ , null , size -- ** Utilities- , defaultDistSqrFn+ , defaultSqrDist ) where import Control.DeepSeq import Control.DeepSeq.Generics (genericRnf) import GHC.Generics -import Data.Foldable+import qualified Data.Foldable as F+import Prelude hiding (null) import qualified Data.KdMap.Static as KDM-import Data.KdMap.Static (PointAsListFn, SquaredDistanceFn, defaultDistSqrFn)+import Data.KdMap.Static (PointAsListFn, SquaredDistanceFn, defaultSqrDist) -- $intro --@@ -100,11 +108,11 @@ -- @ -- >>> let dataPoints = [(Point3d 0.0 0.0 0.0), (Point3d 1.0 1.0 1.0)] ----- >>> let kdt = 'buildKdTree' point3dAsList dataPoints+-- >>> let kdt = 'build' point3dAsList dataPoints -- -- >>> let queryPoint = Point3d 0.1 0.1 0.1 ----- >>> 'nearestNeighbor' kdt queryPoint+-- >>> 'nearest' kdt queryPoint -- Point3d {x = 0.0, y = 0.0, z = 0.0} -- @ @@ -128,7 +136,7 @@ -- -- You may have noticed in the previous use case that we never -- specified what "nearest" means for our points. By default,--- 'buildKdTree' uses a Euclidean distance function that is sufficient+-- 'build' uses a Euclidean distance function that is sufficient -- in most cases. However, point queries are typically faster on a -- 'KdTree' built with a user-specified custom distance -- function. Let's generate a 'KdTree' using a custom distance@@ -156,7 +164,7 @@ -- We can build a 'KdTree' using our custom distance function as follows: -- -- @--- >>> let kdt = 'buildKdTreeWithDistFn' point3dAsList point3dSquaredDistance points+-- >>> let kdt = 'buildWithDist' point3dAsList point3dSquaredDistance points -- @ -- $axisvaluetypes@@ -173,7 +181,7 @@ -- point2iAsList (Point2i x y) = [x, y] -- -- kdt :: [Point2i] -> KdTree Int Point2i--- kdt dataPoints = buildKdTree point2iAsList dataPoints+-- kdt dataPoints = 'build' point2iAsList dataPoints -- @ -- | A /k/-d tree structure that stores points of type @p@ with axis@@ -181,25 +189,51 @@ newtype KdTree a p = KdTree (KDM.KdMap a p ()) deriving Generic instance (NFData a, NFData p) => NFData (KdTree a p) where rnf = genericRnf -instance Foldable (KdTree a) where- foldr f z (KdTree kdMap) = KDM.foldrKdMap (f . fst) z kdMap+instance (Show a, Show p) => Show (KdTree a p) where+ show (KdTree kdm) = "KdTree " ++ show kdm +instance F.Foldable (KdTree a) where+ foldr f z (KdTree kdMap) = KDM.foldrWithKey (f . fst) z kdMap++-- | Builds an empty 'KdTree'.+empty :: Real a => PointAsListFn a p -> KdTree a p+empty = KdTree . KDM.empty++-- | Builds an empty 'KdTree' using a user-specified squared distance+-- function.+emptyWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> KdTree a p+emptyWithDist p2l d2 = KdTree $ KDM.emptyWithDist p2l d2++-- | Builds a 'KdTree' with a single point.+singleton :: Real a => PointAsListFn a p -> p -> KdTree a p+singleton p2l p = KdTree $ KDM.singleton p2l (p, ())++-- | Builds a 'KdTree' with a single point using a user-specified+-- squared distance function.+singletonWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> p+ -> KdTree a p+singletonWithDist p2l d2 p = KdTree $ KDM.singletonWithDist p2l d2 (p, ())++null :: KdTree a p -> Bool+null (KdTree kdm) = KDM.null kdm+ -- | Builds a 'KdTree' from a list of data points using a default--- squared distance function 'defaultDistSqrFn'.+-- squared distance function 'defaultSqrDist'. -- -- Average complexity: /O(n * log(n))/ for /n/ data points. -- -- Worst case time complexity: /O(n^2)/ for /n/ data points. -- -- Worst case space complexity: /O(n)/ for /n/ data points.------ Throws an error if given an empty list of data points.-buildKdTree :: Real a => PointAsListFn a p- -> [p] -- ^ non-empty list of data points to be stored in the /k/-d tree- -> KdTree a p-buildKdTree _ [] = error "KdTree must be built with a non-empty list."-buildKdTree pointAsList ps =- KdTree $ KDM.buildKdMap pointAsList $ zip ps $ repeat ()+build :: Real a => PointAsListFn a p+ -> [p] -- ^ non-empty list of data points to be stored in the /k/-d tree+ -> KdTree a p+build pointAsList ps =+ KdTree $ KDM.build pointAsList $ zip ps $ repeat () -- | Builds a 'KdTree' from a list of data points using a -- user-specified squared distance function.@@ -209,24 +243,49 @@ -- Worst case time complexity: /O(n^2)/ for /n/ data points. -- -- Worst case space complexity: /O(n)/ for /n/ data points.+buildWithDist :: Real a => PointAsListFn a p+ -> SquaredDistanceFn a p+ -> [p]+ -> KdTree a p+buildWithDist pointAsList distSqr ps =+ KdTree $ KDM.buildWithDist pointAsList distSqr $ zip ps $ repeat ()++-- | Inserts a point into a 'KdTree'. This can potentially+-- cause the internal tree structure to become unbalanced. If the tree+-- becomes too unbalanced, point queries will be very inefficient. If+-- you need to perform lots of point insertions on an already existing+-- /k/-d tree, check out+-- @Data.KdTree.Dynamic.@'Data.KdTree.Dynamic.KdTree'. ----- Throws an error if given an empty list of data points.-buildKdTreeWithDistFn :: Real a => PointAsListFn a p- -> SquaredDistanceFn a p- -> [p]- -> KdTree a p-buildKdTreeWithDistFn _ _ [] = error "KdTree must be built with a non-empty list."-buildKdTreeWithDistFn pointAsList distSqr ps =- KdTree $ KDM.buildKdMapWithDistFn pointAsList distSqr $ zip ps $ repeat ()+-- Average complexity: /O(log(n))/ for /n/ data points.+--+-- Worse case time complexity: /O(n)/ for /n/ data points.+insertUnbalanced :: Real a => KdTree a p -> p -> KdTree a p+insertUnbalanced (KdTree kdm) p = KdTree $ KDM.insertUnbalanced kdm p () +-- | Inserts a list of points into a 'KdTree'. This can potentially+-- cause the internal tree structure to become unbalanced, which leads+-- to inefficient point queries.+--+-- Average complexity: /O(n * log(n))/ for /n/ data points.+--+-- Worst case time complexity: /O(n^2)/ for /n/ data points.+batchInsertUnbalanced :: Real a => KdTree a p -> [p] -> KdTree a p+batchInsertUnbalanced (KdTree kdm) ps =+ KdTree $ KDM.batchInsertUnbalanced kdm $ zip ps $ repeat ()+ -- | Given a 'KdTree' and a query point, returns the nearest point -- in the 'KdTree' to the query point. -- -- Average time complexity: /O(log(n))/ for /n/ data points. -- -- Worst case time complexity: /O(n)/ for /n/ data points.-nearestNeighbor :: Real a => KdTree a p -> p -> p-nearestNeighbor (KdTree t) query = fst $ KDM.nearestNeighbor t query+--+-- Throws an error if called on an empty 'KdTree'.+nearest :: Real a => KdTree a p -> p -> p+nearest (KdTree t) query+ | KDM.null t = error "Attempted to call nearest on an empty KdTree."+ | otherwise = fst $ KDM.nearest t query -- | Given a 'KdTree', a query point, and a radius, returns all -- points in the 'KdTree' that are within the given radius of the@@ -236,12 +295,12 @@ -- -- Worst case time complexity: /O(n)/ for /n/ data points and -- a radius that subsumes all points in the structure.-pointsInRadius :: Real a => KdTree a p- -> a -- ^ radius- -> p -- ^ query point- -> [p] -- ^ list of points in tree with- -- given radius of query point-pointsInRadius (KdTree t) radius query = map fst $ KDM.pointsInRadius t radius query+inRadius :: Real a => KdTree a p+ -> a -- ^ radius+ -> p -- ^ query point+ -> [p] -- ^ list of points in tree with given+ -- radius of query point+inRadius (KdTree t) radius query = map fst $ KDM.inRadius t radius query -- | Given a 'KdTree', a query point, and a number @k@, returns the -- @k@ nearest points in the 'KdTree' to the query point.@@ -254,8 +313,8 @@ -- -- Worst case time complexity: /n * log(k)/ for /k/ nearest -- neighbors on a structure with /n/ data points.-kNearestNeighbors :: Real a => KdTree a p -> Int -> p -> [p]-kNearestNeighbors (KdTree t) k query = map fst $ KDM.kNearestNeighbors t k query+kNearest :: Real a => KdTree a p -> Int -> p -> [p]+kNearest (KdTree t) k query = map fst $ KDM.kNearest t k query -- | Finds all points in a 'KdTree' with points within a given range, -- where the range is specified as a set of lower and upper bounds.@@ -264,17 +323,17 @@ -- -- Worst case time complexity: /O(n)/ for n data points and a range -- that spans all the points.-pointsInRange :: Real a => KdTree a p- -> p -- ^ lower bounds of range- -> p -- ^ upper bounds of range- -> [p] -- ^ all points within given range-pointsInRange (KdTree t) lower upper = map fst $ KDM.pointsInRange t lower upper+inRange :: Real a => KdTree a p+ -> p -- ^ lower bounds of range+ -> p -- ^ upper bounds of range+ -> [p] -- ^ all points within given range+inRange (KdTree t) lower upper = map fst $ KDM.inRange t lower upper -- | Returns a list of all the points in the 'KdTree'. -- -- Time complexity: /O(n)/ for /n/ data points.-points :: KdTree a p -> [p]-points (KdTree t) = KDM.points t+toList :: KdTree a p -> [p]+toList (KdTree t) = KDM.keys t -- | Returns the number of elements in the 'KdTree'. --
− lib-src/Data/Point2d.hs
@@ -1,27 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--{-# LANGUAGE DeriveGeneric #-}--module Data.Point2d where--import Control.DeepSeq-import Control.DeepSeq.Generics (genericRnf)-import GHC.Generics-import Test.QuickCheck--data Point2d = Point2d Double Double deriving (Show, Eq, Ord, Generic)-instance NFData Point2d where rnf = genericRnf--pointAsList2d :: Point2d -> [Double]-pointAsList2d (Point2d x y) = [x, y]--distSqr2d :: Point2d -> Point2d -> Double-distSqr2d (Point2d x1 y1) (Point2d x2 y2) = let dx = x2 - x1- dy = y2 - y1- in dx*dx + dy*dy--instance Arbitrary Point2d where- arbitrary = do- x <- arbitrary- y <- arbitrary- return (Point2d x y)