Data/Interval/Sieve/Test.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE TupleSections #-}
   5 module Sieve.Test where
   6
   7 import Data.Function (($), (.), flip, on)
   8 import Data.Functor ((<$>))
   9 import Data.List (concatMap, foldl, foldr, unwords, reverse)
  10 import Data.Maybe (Maybe(..), fromJust)
  11 import Data.Monoid ((<>))
  12 import Prelude (Integer)
  13 import Test.Tasty
  14 import Test.Tasty.HUnit
  15 import Text.Show (Show(..))
  16
  17 import qualified Data.Interval as Interval
  18 import qualified Data.Interval.Sieve as Interval.Sieve
  19
  20 tests :: TestTree
  21 tests = testGroup "Sieve"
  22  [ testGroup "union" $
  23         concatMap
  24          (\(mis, me) ->
  25                 let is = fromJust <$> mis in
  26                 let e  = fromJust <$> me in
  27                 let sil = foldl
  28                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
  29                          Interval.Sieve.empty is in
  30                 let sir = foldr
  31                          (Interval.Sieve.union . Interval.Sieve.singleton)
  32                          Interval.Sieve.empty is in
  33                 [ testCase (unwords $ (show . Interval.Pretty) <$> is) $
  34                         Interval.Sieve.intervals sil @?= e
  35                 , testCase (unwords $ (show . Interval.Pretty) <$> reverse is) $
  36                         Interval.Sieve.intervals sir @?= e
  37                 ]
  38          )
  39          [ ( [ (Interval.<=..<)  0 (5::Integer)
  40                          , (Interval.<=..<=) 5 9
  41                          ]
  42                  , [ (Interval.<=..<=) 0 9 ]
  43                  )
  44          , ( [ (Interval.<=..<=) 0 5
  45                          , (Interval.<=..<=) 0 9
  46                          ]
  47                  , [ (Interval.<=..<=) 0 9 ]
  48                  )
  49          , ( [ (Interval.<=..<=) 0 4
  50                          , (Interval.<=..<=) 5 9
  51                          , (Interval.<=..<=) 3 6
  52                          ]
  53                  , [ (Interval.<=..<=) 0 9 ]
  54                  )
  55          , ( [ (Interval.<=..<=) 1 4
  56                          , (Interval.<=..<=) 5 8
  57                          ]
  58                  , [ (Interval.<=..<=) 1 4
  59                          , (Interval.<=..<=) 5 8
  60                          ]
  61                  )
  62          , ( [ (Interval.<=..<=) 1 8
  63                          , (Interval.<=..<=) 0 9
  64                          ]
  65                  , [ (Interval.<=..<=) 0 9 ]
  66                  )
  67          , ( [ (Interval.<=..<=) 1 4
  68                          , (Interval.<=..<=) 5 8
  69                          , (Interval.<=..<=) 0 9
  70                          ]
  71                  , [ (Interval.<=..<=) 0 9 ]
  72                  )
  73          ] <>
  74         concatMap
  75          (\(mis, mjs, me) ->
  76                 let is = fromJust <$> mis in
  77                 let js = fromJust <$> mjs in
  78                 let e  = fromJust <$> me in
  79                 let iu = foldl
  80                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
  81                          Interval.Sieve.empty is in
  82                 let ju = foldl
  83                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
  84                          Interval.Sieve.empty js in
  85                 [ testCase (unwords ((show . Interval.Pretty) <$> is) <> " u " <>
  86                                 unwords ((show . Interval.Pretty) <$> js)) $
  87                         Interval.Sieve.intervals (Interval.Sieve.union iu ju) @?= e
  88                 , testCase (unwords ((show . Interval.Pretty) <$> js) <> " u " <>
  89                                 unwords ((show . Interval.Pretty) <$> is)) $
  90                         Interval.Sieve.intervals (Interval.Sieve.union ju iu) @?= e
  91                 ]
  92          )
  93          [ ( [ (Interval.<=..<=) 0 (1::Integer)
  94                    , (Interval.<=..<=) 2 4
  95                    ]
  96                  , [ (Interval.<=..<=) 0 3
  97                    ]
  98                  , [ (Interval.<=..<=) 0 4
  99                    ]
 100                  )
 101          , ( [ (Interval.<=..<=) 0 1
 102                    , (Interval.<=..<=) 2 3
 103                    , (Interval.<=..<=) 4 5
 104                    , (Interval.<=..<=) 6 7
 105                    ]
 106                  , [ (Interval.<=..<=) 1 2
 107                    , (Interval.<=..<=) 3 4
 108                    , (Interval.<=..<=) 5 6
 109                    ]
 110                  , [ (Interval.<=..<=) 0 7
 111                    ]
 112                  )
 113          , ( [ (Interval.<=..<=) 0 1
 114                    , (Interval.<=..<=) 2 3
 115                    ]
 116                  , [ (Interval.<=..<=) 4 5
 117                    ]
 118                  , [ (Interval.<=..<=) 0 1
 119                    , (Interval.<=..<=) 2 3
 120                    , (Interval.<=..<=) 4 5
 121                    ]
 122                  )
 123          , ( [ (Interval.<=..<=) 0 1
 124                    , (Interval.<=..<=) 4 5
 125                    ]
 126                  , [ (Interval.<=..<=) 2 3
 127                    ]
 128                  , [ (Interval.<=..<=) 0 1
 129                    , (Interval.<=..<=) 2 3
 130                    , (Interval.<=..<=) 4 5
 131                    ]
 132                  )
 133          ]
 134  , testGroup "intersection" $
 135         concatMap
 136          (\(mis, mjs, me) ->
 137                 let is = fromJust <$> mis in
 138                 let js = fromJust <$> mjs in
 139                 let e  = fromJust <$> me in
 140                 let iu = foldl
 141                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
 142                          Interval.Sieve.empty is in
 143                 let ju = foldl
 144                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
 145                          Interval.Sieve.empty js in
 146                 [ testCase (unwords ((show . Interval.Pretty) <$> is) <> " n " <>
 147                                 unwords ((show . Interval.Pretty) <$> js)) $
 148                         Interval.Sieve.intervals (Interval.Sieve.intersection iu ju) @?= e
 149                 , testCase (unwords ((show . Interval.Pretty) <$> js) <> " n " <>
 150                                 unwords ((show . Interval.Pretty) <$> is)) $
 151                         Interval.Sieve.intervals (Interval.Sieve.intersection ju iu) @?= e
 152                 ]
 153          )
 154          [ ( [ (Interval.<=..<)  0 (5::Integer) ]
 155                  , [ (Interval.<=..<=) 5 9 ]
 156                  , [ ]
 157                  )
 158          , ( [ (Interval.<=..<=) 0 5 ]
 159                  , [ (Interval.<=..<=) 5 9 ]
 160                  , [ (Interval.<=..<=) 5 5 ]
 161                  )
 162          , ( [ (Interval.<=..<=) 0 5 ]
 163                  , [ (Interval.<=..<=) 0 9 ]
 164                  , [ (Interval.<=..<=) 0 5 ]
 165                  )
 166          , ( [ (Interval.<=..<=) 0 4
 167                          , (Interval.<=..<=) 5 9
 168                          ]
 169                  , [ (Interval.<=..<=) 3 6 ]
 170                  , [ (Interval.<=..<=) 3 4
 171                          , (Interval.<=..<=) 5 6
 172                          ]
 173                  )
 174          , ( [ (Interval.<=..<=) 1 4
 175                          , (Interval.<=..<=) 6 8
 176                          ]
 177                  , [ (Interval.<=..<=) 2 3
 178                          , (Interval.<=..<=) 5 7
 179                          ]
 180                  , [ (Interval.<=..<=) 2 3
 181                          , (Interval.<=..<=) 6 7
 182                          ]
 183                  )
 184          ]
 185  , testGroup "complement" $
 186         concatMap
 187          (\(mis, me) ->
 188                 let is = fromJust <$> mis in
 189                 let e  = fromJust <$> me in
 190                 let iu = foldl
 191                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
 192                          Interval.Sieve.empty is in
 193                 [ testCase (show (Interval.Pretty $
 194                         Interval.Sieve.fmap_interval
 195                                 (Interval.fmap_unsafe Interval.Pretty) iu)) $
 196                         Interval.Sieve.intervals (Interval.Sieve.complement iu) @?= e
 197                 ]
 198          )
 199          [ ( [ ((Interval.<=..<)  `on` Interval.Limited) 0 (5::Integer)
 200                          , ((Interval.<=..<=) `on` Interval.Limited) 5 9
 201                          ]
 202                  , [ Just $ (Interval...<) 0
 203                          , Just $ (Interval.<..) 9
 204                          ]
 205                  )
 206          , ( [ Just Interval.unlimited ]
 207                  , [ ]
 208                  )
 209          , ( [ ]
 210                  , [ Just Interval.unlimited ]
 211                  )
 212          , ( [ Just $ (Interval...<) 0
 213                          , Just $ (Interval.<..) 0
 214                          ]
 215                  , [ Just $ Interval.point $ Interval.Limited 0
 216                          ]
 217                  )
 218          , ( [ ((Interval.<=..<) `on` Interval.Limited) 0 1
 219                          , ((Interval.<=..<) `on` Interval.Limited) 2 3
 220                          , ((Interval.<..<=) `on` Interval.Limited) 3 4
 221                          ]
 222                  , [ Just $ (Interval...<) 0
 223                          ,       ((Interval.<=..<) `on` Interval.Limited) 1 2
 224                          , Just $ Interval.point $ Interval.Limited 3
 225                          , Just $ (Interval.<..) 4
 226                          ]
 227                  )
 228          ]
 229  , testGroup "complement_with" $
 230         concatMap
 231          (\(mib, mis, me) ->
 232                 let ib = fromJust mib in
 233                 let is = fromJust <$> mis in
 234                 let e  = fromJust <$> me in
 235                 let iu = foldl
 236                          (flip (Interval.Sieve.union . Interval.Sieve.singleton))
 237                          Interval.Sieve.empty is in
 238                 [ testCase (show (Interval.Pretty iu)) $
 239                         Interval.Sieve.intervals
 240                          (Interval.Sieve.complement_with ib iu) @?= e
 241                 ]
 242          )
 243          [ ( (Interval.<=..<=)   (-10) (10::Integer)
 244                  , [ (Interval.<=..<)  0 5
 245                          , (Interval.<=..<=) 5 9
 246                          ]
 247                  , [ (Interval.<=..<) (-10) 0
 248                          , (Interval.<..<=) 9 10
 249                          ]
 250                  )
 251          , ( (Interval.<=..<=) (-10) 10
 252                  , [ (Interval.<=..<=) (-10) 10 ]
 253                  , [ ]
 254                  )
 255          , ( (Interval.<=..<=) (-10) 10
 256                  , [ ]
 257                  , [ (Interval.<=..<=) (-10) 10 ]
 258                  )
 259          , ( (Interval.<=..<=) (-10) 10
 260                  , [ (Interval.<=..<) (-10) 0
 261                          , (Interval.<..<=) 0 10
 262                          ]
 263                  , [ Just $ Interval.point 0
 264                          ]
 265                  )
 266          , ( (Interval.<=..<=) (-10) 10
 267                  , [ Just $ Interval.point 0
 268                          ]
 269                  , [ (Interval.<=..<) (-10) 0
 270                          , (Interval.<..<=) 0 10
 271                          ]
 272                  )
 273          , ( (Interval.<=..<=) 0 10
 274                  , [ (Interval.<..<=) 0 10
 275                          ]
 276                  , [ Just $ Interval.point 0
 277                          ]
 278                  )
 279          , ( (Interval.<=..<=) 0 10
 280                  , [ (Interval.<=..<) 0 10
 281                          ]
 282                  , [ Just $ Interval.point 10
 283                          ]
 284                  )
 285          , ( Just $ Interval.point 0
 286                  , [
 287                          ]
 288                  , [ Just $ Interval.point 0
 289                          ]
 290                  )
 291          , ( Just $ Interval.point 0
 292                  , [ Just $ Interval.point 0
 293                          ]
 294                  , [
 295                          ]
 296                  )
 297          ]
 298  ]