SegmentTree-0.2: src/Tests.hs

import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Providers.QuickCheck2 (testProperty)

import Test.QuickCheck
import Test.HUnit

import Data.List

import qualified Stabbing.Naive as N
import qualified Stabbing.SegmentTree as ST

main = defaultMain tests

tests = [
  testGroup "Naive implementation" [
     testCase "naive_sample" test_naive_sample,
     testProperty "naive_lower" prop_naive_lower,
     testProperty "naive_upper" prop_naive_upper,
     testProperty "naive_center" prop_naive_center
     ],
  testGroup "SegmentTree" [
     testCase     "segment_tree_sample" test_segmenttree_sample,
     testProperty "segment_tree_lower"  prop_segmenttree_lower,
     testProperty "segment_tree_upper"  prop_segmenttree_upper,
     testProperty "segment_tree_center" prop_segmenttree_center
    ],  
  testGroup "Crosscheck" [
     testProperty "naive_vs_segmenttree"  prop_naive_vs_segmenttree,
     testProperty "interval_order_oblivious"  prop_ivl_order_oblivious,
     testProperty "point_order_oblivious"  prop_pts_order_oblivious
    ]
  ]

-- Test sample from the task description
test_naive_sample = N.counts [(0, 10), (5, 20), (25, 30)] [5, 20, 27, 100] @?= [2, 1, 1, 0]
test_segmenttree_sample = ST.counts [(0, 10), (5, 20), (25, 30)] [5, 20, 27, 100] @?= [2, 1, 1, 0]

-- List of random intervals could be made from list of random pairs by applying `proper' to them.
-- `proper' just makes sure that lower bound is <= upper bound for all pairs
proper = map (\(x,y) -> if x > y then (y,x) else (x,y))

-- Test that point selected from each interval using `pointSelector' scores at least one hit
prop_at_least_once impl pointSelector pairs = 
  (not (null pairs)) ==>
  all (>=1) $ impl intervals (map pointSelector intervals)
  where intervals = proper pairs

-- Test that lower, upper bounds and midpoint of each interval score at least one hit
prop_naive_lower  = prop_at_least_once N.counts fst
prop_naive_upper  = prop_at_least_once N.counts snd
prop_naive_center = prop_at_least_once N.counts (\(l,u) -> (l+u) / 2)
prop_segmenttree_lower  = prop_at_least_once ST.counts fst
prop_segmenttree_upper  = prop_at_least_once ST.counts snd
prop_segmenttree_center = prop_at_least_once ST.counts (\(l,u) -> (l+u) / 2)


-- Test segment tree against naive implementation
prop_naive_vs_segmenttree pairs points = 
  (not (null pairs)) ==>
  N.counts intervals points == ST.counts intervals points
    where intervals = proper pairs

-- Test that order of intervals does not matter
prop_ivl_order_oblivious pairs points = 
  (not (null pairs)) ==>
  N.counts intervals points == ST.counts (reverse intervals) points
    where intervals = proper pairs

-- Test that order of points does not matter
prop_pts_order_oblivious pairs points = 
  (not (null pairs)) ==>
  N.counts intervals points == reverse (ST.counts intervals (reverse points))
    where intervals = proper pairs