StaticTest.hs

{-# LANGUAGE TemplateHaskell, CPP #-}

import Data.KdMap.Static as KDM

import Control.Monad
import Data.List
import Data.Ord
import Data.Point2d
import System.Exit
import Test.QuickCheck

#if MIN_VERSION_QuickCheck(2,7,0)
#else
import Test.QuickCheck.All
#endif

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