interval-1.20160821: Data/Interval/Sieve/Test.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Sieve.Test where

import Data.Function (($), (.), flip, on)
import Data.Functor ((<$>))
import Data.List (concatMap, foldl, foldr, unwords, reverse)
import Data.Maybe (Maybe(..), fromJust)
import Data.Monoid ((<>))
import Prelude (Integer)
import Test.Tasty
import Test.Tasty.HUnit
import Text.Show (Show(..))

import qualified Data.Interval as Interval
import qualified Data.Interval.Sieve as Interval.Sieve

tests :: TestTree
tests = testGroup "Sieve"
 [ testGroup "union" $
	concatMap
	 (\(mis, me) ->
		let is = fromJust <$> mis in
		let e  = fromJust <$> me in
		let sil = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty is in
		let sir = foldr
			 (Interval.Sieve.union . Interval.Sieve.singleton)
			 Interval.Sieve.empty is in
		[ testCase (unwords $ (show . Interval.Pretty) <$> is) $
			Interval.Sieve.intervals sil @?= e
		, testCase (unwords $ (show . Interval.Pretty) <$> reverse is) $
			Interval.Sieve.intervals sir @?= e
		]
	 )
	 [ ( [ (Interval.<=..<)  0 (5::Integer)
			 , (Interval.<=..<=) 5 9
			 ]
		 , [ (Interval.<=..<=) 0 9 ]
		 )
	 , ( [ (Interval.<=..<=) 0 5
			 , (Interval.<=..<=) 0 9
			 ]
		 , [ (Interval.<=..<=) 0 9 ]
		 )
	 , ( [ (Interval.<=..<=) 0 4
			 , (Interval.<=..<=) 5 9
			 , (Interval.<=..<=) 3 6
			 ]
		 , [ (Interval.<=..<=) 0 9 ]
		 )
	 , ( [ (Interval.<=..<=) 1 4
			 , (Interval.<=..<=) 5 8
			 ]
		 , [ (Interval.<=..<=) 1 4
			 , (Interval.<=..<=) 5 8
			 ]
		 )
	 , ( [ (Interval.<=..<=) 1 8
			 , (Interval.<=..<=) 0 9
			 ]
		 , [ (Interval.<=..<=) 0 9 ]
		 )
	 , ( [ (Interval.<=..<=) 1 4
			 , (Interval.<=..<=) 5 8
			 , (Interval.<=..<=) 0 9
			 ]
		 , [ (Interval.<=..<=) 0 9 ]
		 )
	 ] <>
	concatMap
	 (\(mis, mjs, me) ->
		let is = fromJust <$> mis in
		let js = fromJust <$> mjs in
		let e  = fromJust <$> me in
		let iu = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty is in
		let ju = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty js in
		[ testCase (unwords ((show . Interval.Pretty) <$> is) <> " u " <>
				unwords ((show . Interval.Pretty) <$> js)) $
			Interval.Sieve.intervals (Interval.Sieve.union iu ju) @?= e
		, testCase (unwords ((show . Interval.Pretty) <$> js) <> " u " <>
				unwords ((show . Interval.Pretty) <$> is)) $
			Interval.Sieve.intervals (Interval.Sieve.union ju iu) @?= e
		]
	 )
	 [ ( [ (Interval.<=..<=) 0 (1::Integer)
		   , (Interval.<=..<=) 2 4
		   ]
		 , [ (Interval.<=..<=) 0 3
		   ]
		 , [ (Interval.<=..<=) 0 4
		   ]
		 )
	 , ( [ (Interval.<=..<=) 0 1
		   , (Interval.<=..<=) 2 3
		   , (Interval.<=..<=) 4 5
		   , (Interval.<=..<=) 6 7
		   ]
		 , [ (Interval.<=..<=) 1 2
		   , (Interval.<=..<=) 3 4
		   , (Interval.<=..<=) 5 6
		   ]
		 , [ (Interval.<=..<=) 0 7
		   ]
		 )
	 , ( [ (Interval.<=..<=) 0 1
		   , (Interval.<=..<=) 2 3
		   ]
		 , [ (Interval.<=..<=) 4 5
		   ]
		 , [ (Interval.<=..<=) 0 1
		   , (Interval.<=..<=) 2 3
		   , (Interval.<=..<=) 4 5
		   ]
		 )
	 , ( [ (Interval.<=..<=) 0 1
		   , (Interval.<=..<=) 4 5
		   ]
		 , [ (Interval.<=..<=) 2 3
		   ]
		 , [ (Interval.<=..<=) 0 1
		   , (Interval.<=..<=) 2 3
		   , (Interval.<=..<=) 4 5
		   ]
		 )
	 ]
 , testGroup "intersection" $
	concatMap
	 (\(mis, mjs, me) ->
		let is = fromJust <$> mis in
		let js = fromJust <$> mjs in
		let e  = fromJust <$> me in
		let iu = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty is in
		let ju = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty js in
		[ testCase (unwords ((show . Interval.Pretty) <$> is) <> " n " <>
				unwords ((show . Interval.Pretty) <$> js)) $
			Interval.Sieve.intervals (Interval.Sieve.intersection iu ju) @?= e
		, testCase (unwords ((show . Interval.Pretty) <$> js) <> " n " <>
				unwords ((show . Interval.Pretty) <$> is)) $
			Interval.Sieve.intervals (Interval.Sieve.intersection ju iu) @?= e
		]
	 )
	 [ ( [ (Interval.<=..<)  0 (5::Integer) ]
		 , [ (Interval.<=..<=) 5 9 ]
		 , [ ]
		 )
	 , ( [ (Interval.<=..<=) 0 5 ]
		 , [ (Interval.<=..<=) 5 9 ]
		 , [ (Interval.<=..<=) 5 5 ]
		 )
	 , ( [ (Interval.<=..<=) 0 5 ]
		 , [ (Interval.<=..<=) 0 9 ]
		 , [ (Interval.<=..<=) 0 5 ]
		 )
	 , ( [ (Interval.<=..<=) 0 4
			 , (Interval.<=..<=) 5 9
			 ]
		 , [ (Interval.<=..<=) 3 6 ]
		 , [ (Interval.<=..<=) 3 4
			 , (Interval.<=..<=) 5 6
			 ]
		 )
	 , ( [ (Interval.<=..<=) 1 4
			 , (Interval.<=..<=) 6 8
			 ]
		 , [ (Interval.<=..<=) 2 3
			 , (Interval.<=..<=) 5 7
			 ]
		 , [ (Interval.<=..<=) 2 3
			 , (Interval.<=..<=) 6 7
			 ]
		 )
	 ]
 , testGroup "complement" $
	concatMap
	 (\(mis, me) ->
		let is = fromJust <$> mis in
		let e  = fromJust <$> me in
		let iu = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty is in
		[ testCase (show (Interval.Pretty $
			Interval.Sieve.fmap_interval
				(Interval.fmap_unsafe Interval.Pretty) iu)) $
			Interval.Sieve.intervals (Interval.Sieve.complement iu) @?= e
		]
	 )
	 [ ( [ ((Interval.<=..<)  `on` Interval.Limited) 0 (5::Integer)
			 , ((Interval.<=..<=) `on` Interval.Limited) 5 9
			 ]
		 , [ Just $ (Interval...<) 0
			 , Just $ (Interval.<..) 9
			 ]
		 )
	 , ( [ Just Interval.unlimited ]
		 , [ ]
		 )
	 , ( [ ]
		 , [ Just Interval.unlimited ]
		 )
	 , ( [ Just $ (Interval...<) 0
			 , Just $ (Interval.<..) 0
			 ]
		 , [ Just $ Interval.point $ Interval.Limited 0
			 ]
		 )
	 , ( [ ((Interval.<=..<) `on` Interval.Limited) 0 1
			 , ((Interval.<=..<) `on` Interval.Limited) 2 3
			 , ((Interval.<..<=) `on` Interval.Limited) 3 4
			 ]
		 , [ Just $ (Interval...<) 0
			 ,       ((Interval.<=..<) `on` Interval.Limited) 1 2
			 , Just $ Interval.point $ Interval.Limited 3
			 , Just $ (Interval.<..) 4
			 ]
		 )
	 ]
 , testGroup "complement_with" $
	concatMap
	 (\(mib, mis, me) ->
		let ib = fromJust mib in
		let is = fromJust <$> mis in
		let e  = fromJust <$> me in
		let iu = foldl
			 (flip (Interval.Sieve.union . Interval.Sieve.singleton))
			 Interval.Sieve.empty is in
		[ testCase (show (Interval.Pretty iu)) $
			Interval.Sieve.intervals
			 (Interval.Sieve.complement_with ib iu) @?= e
		]
	 )
	 [ ( (Interval.<=..<=)   (-10) (10::Integer)
		 , [ (Interval.<=..<)  0 5
			 , (Interval.<=..<=) 5 9
			 ]
		 , [ (Interval.<=..<) (-10) 0
			 , (Interval.<..<=) 9 10
			 ]
		 )
	 , ( (Interval.<=..<=) (-10) 10
		 , [ (Interval.<=..<=) (-10) 10 ]
		 , [ ]
		 )
	 , ( (Interval.<=..<=) (-10) 10
		 , [ ]
		 , [ (Interval.<=..<=) (-10) 10 ]
		 )
	 , ( (Interval.<=..<=) (-10) 10
		 , [ (Interval.<=..<) (-10) 0
			 , (Interval.<..<=) 0 10
			 ]
		 , [ Just $ Interval.point 0
			 ]
		 )
	 , ( (Interval.<=..<=) (-10) 10
		 , [ Just $ Interval.point 0
			 ]
		 , [ (Interval.<=..<) (-10) 0
			 , (Interval.<..<=) 0 10
			 ]
		 )
	 , ( (Interval.<=..<=) 0 10
		 , [ (Interval.<..<=) 0 10
			 ]
		 , [ Just $ Interval.point 0
			 ]
		 )
	 , ( (Interval.<=..<=) 0 10
		 , [ (Interval.<=..<) 0 10
			 ]
		 , [ Just $ Interval.point 10
			 ]
		 )
	 , ( Just $ Interval.point 0
		 , [
			 ]
		 , [ Just $ Interval.point 0
			 ]
		 )
	 , ( Just $ Interval.point 0
		 , [ Just $ Interval.point 0
			 ]
		 , [
			 ]
		 )
	 ]
 ]