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