{-# 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