init

[haskell/interval.git] / 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
                         ]
                 , [
                         ]
                 )
         ]
 ]