{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntervalSet
-- Copyright   :  (c) Masahiro Sakai 2016
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf)
--
-- Interval datatype and interval arithmetic.
--
-----------------------------------------------------------------------------
module Data.IntervalSet
  (
  -- * IntervalSet type
    IntervalSet
  , module Data.ExtendedReal

  -- * Construction
  , whole
  , empty
  , singleton

  -- * Query
  , null
  , member
  , notMember
  , isSubsetOf
  , isProperSubsetOf
  , span

  -- * Construction
  , complement
  , insert
  , delete

  -- * Combine
  , union
  , unions
  , intersection
  , intersections
  , difference

  -- * Conversion

  -- ** List
  , fromList
  , toList

  -- ** Ordered list
  , toAscList
  , toDescList
  , fromAscList
  )
  where

import Prelude hiding (null, span)
#ifdef MIN_VERSION_lattices
import Algebra.Lattice
#endif
import Control.DeepSeq
import Data.Data
import Data.ExtendedReal
import Data.Function
import Data.Hashable
import Data.List (sortBy, foldl')
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Semigroup as Semigroup
import Data.Interval (Interval, Boundary(..))
import qualified Data.Interval as Interval
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid (Monoid(..))
#endif
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif

-- | A set comprising zero or more non-empty, /disconnected/ intervals.
--
-- Any connected intervals are merged together, and empty intervals are ignored.
newtype IntervalSet r = IntervalSet (Map (Extended r) (Interval r))
  deriving (IntervalSet r -> IntervalSet r -> Bool
(IntervalSet r -> IntervalSet r -> Bool)
-> (IntervalSet r -> IntervalSet r -> Bool) -> Eq (IntervalSet r)
forall r. Eq r => IntervalSet r -> IntervalSet r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntervalSet r -> IntervalSet r -> Bool
$c/= :: forall r. Eq r => IntervalSet r -> IntervalSet r -> Bool
== :: IntervalSet r -> IntervalSet r -> Bool
$c== :: forall r. Eq r => IntervalSet r -> IntervalSet r -> Bool
Eq, Typeable)

#if __GLASGOW_HASKELL__ >= 708
type role IntervalSet nominal
#endif

instance (Ord r, Show r) => Show (IntervalSet r) where
  showsPrec :: Int -> IntervalSet r -> ShowS
showsPrec Int
p (IntervalSet Map (Extended r) (Interval r)
m) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int -> [Interval r] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Map (Extended r) (Interval r) -> [Interval r]
forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m)

instance (Ord r, Read r) => Read (IntervalSet r) where
  readsPrec :: Int -> ReadS (IntervalSet r)
readsPrec Int
p =
    (Bool -> ReadS (IntervalSet r) -> ReadS (IntervalSet r)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ReadS (IntervalSet r) -> ReadS (IntervalSet r))
-> ReadS (IntervalSet r) -> ReadS (IntervalSet r)
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
      (String
"fromList",String
s1) <- ReadS String
lex String
s0
      ([Interval r]
xs,String
s2) <- Int -> ReadS [Interval r]
forall a. Read a => Int -> ReadS a
readsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s1
      (IntervalSet r, String) -> [(IntervalSet r, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r]
xs, String
s2))

appPrec :: Int
appPrec :: Int
appPrec = Int
10

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.

instance (Ord r, Data r) => Data (IntervalSet r) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntervalSet r -> c (IntervalSet r)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z IntervalSet r
x   = ([Interval r] -> IntervalSet r)
-> c ([Interval r] -> IntervalSet r)
forall g. g -> c g
z [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList c ([Interval r] -> IntervalSet r)
-> [Interval r] -> c (IntervalSet r)
forall d b. Data d => c (d -> b) -> d -> c b
`k` IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
x
  toConstr :: IntervalSet r -> Constr
toConstr IntervalSet r
_     = Constr
fromListConstr
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IntervalSet r)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c ([Interval r] -> IntervalSet r) -> c (IntervalSet r)
forall b r. Data b => c (b -> r) -> c r
k (([Interval r] -> IntervalSet r)
-> c ([Interval r] -> IntervalSet r)
forall r. r -> c r
z [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList)
    Int
_ -> String -> c (IntervalSet r)
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: IntervalSet r -> DataType
dataTypeOf IntervalSet r
_   = DataType
setDataType
  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (IntervalSet r))
dataCast1 forall d. Data d => c (t d)
f    = c (t r) -> Maybe (c (IntervalSet r))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t r)
forall d. Data d => c (t d)
f

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
setDataType String
"fromList" [] Fixity
Prefix

setDataType :: DataType
setDataType :: DataType
setDataType = String -> [Constr] -> DataType
mkDataType String
"Data.IntervalSet.IntervalSet" [Constr
fromListConstr]

instance NFData r => NFData (IntervalSet r) where
  rnf :: IntervalSet r -> ()
rnf (IntervalSet Map (Extended r) (Interval r)
m) = Map (Extended r) (Interval r) -> ()
forall a. NFData a => a -> ()
rnf Map (Extended r) (Interval r)
m

instance Hashable r => Hashable (IntervalSet r) where
  hashWithSalt :: Int -> IntervalSet r -> Int
hashWithSalt Int
s (IntervalSet Map (Extended r) (Interval r)
m) = Int -> [(Extended r, Interval r)] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Map (Extended r) (Interval r) -> [(Extended r, Interval r)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Extended r) (Interval r)
m)

#ifdef MIN_VERSION_lattices
#if MIN_VERSION_lattices(2,0,0)

instance (Ord r) => Lattice (IntervalSet r) where
  \/ :: IntervalSet r -> IntervalSet r -> IntervalSet r
(\/) = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
  /\ :: IntervalSet r -> IntervalSet r -> IntervalSet r
(/\) = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection

instance (Ord r) => BoundedJoinSemiLattice (IntervalSet r) where
  bottom :: IntervalSet r
bottom = IntervalSet r
forall r. Ord r => IntervalSet r
empty

instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
  top :: IntervalSet r
top = IntervalSet r
forall r. Ord r => IntervalSet r
whole

#else

instance (Ord r) => JoinSemiLattice (IntervalSet r) where
  join = union

instance (Ord r) => MeetSemiLattice (IntervalSet r) where
  meet = intersection

instance (Ord r) => Lattice (IntervalSet r)

instance (Ord r) => BoundedJoinSemiLattice (IntervalSet r) where
  bottom = empty

instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
  top = whole

instance (Ord r) => BoundedLattice (IntervalSet r)

#endif
#endif

instance Ord r => Monoid (IntervalSet r) where
  mempty :: IntervalSet r
mempty = IntervalSet r
forall r. Ord r => IntervalSet r
empty
  mappend :: IntervalSet r -> IntervalSet r -> IntervalSet r
mappend = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
  mconcat :: [IntervalSet r] -> IntervalSet r
mconcat = [IntervalSet r] -> IntervalSet r
forall r. Ord r => [IntervalSet r] -> IntervalSet r
unions

instance (Ord r) => Semigroup.Semigroup (IntervalSet r) where
  <> :: IntervalSet r -> IntervalSet r -> IntervalSet r
(<>)    = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union
#if !defined(VERSION_semigroups)
  stimes :: b -> IntervalSet r -> IntervalSet r
stimes  = b -> IntervalSet r -> IntervalSet r
forall b a. (Integral b, Monoid a) => b -> a -> a
Semigroup.stimesIdempotentMonoid
#else
#if MIN_VERSION_semigroups(0,17,0)
  stimes  = Semigroup.stimesIdempotentMonoid
#else
  times1p _ a = a
#endif
#endif

lift1
  :: Ord r => (Interval r -> Interval r)
  -> IntervalSet r -> IntervalSet r
lift1 :: (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
f IntervalSet r
as = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r -> Interval r
f Interval r
a | Interval r
a <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
as]

lift2
  :: Ord r => (Interval r -> Interval r -> Interval r)
  -> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 :: (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 Interval r -> Interval r -> Interval r
f IntervalSet r
as IntervalSet r
bs = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList [Interval r -> Interval r -> Interval r
f Interval r
a Interval r
b | Interval r
a <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
as, Interval r
b <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
bs]

instance (Num r, Ord r) => Num (IntervalSet r) where
  + :: IntervalSet r -> IntervalSet r -> IntervalSet r
(+) = (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 Interval r -> Interval r -> Interval r
forall a. Num a => a -> a -> a
(+)

  * :: IntervalSet r -> IntervalSet r -> IntervalSet r
(*) = (Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r -> Interval r)
-> IntervalSet r -> IntervalSet r -> IntervalSet r
lift2 Interval r -> Interval r -> Interval r
forall a. Num a => a -> a -> a
(*)

  negate :: IntervalSet r -> IntervalSet r
negate = (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
forall a. Num a => a -> a
negate

  abs :: IntervalSet r -> IntervalSet r
abs = (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
forall a. Num a => a -> a
abs

  fromInteger :: Integer -> IntervalSet r
fromInteger Integer
i = Interval r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r
singleton (Integer -> Interval r
forall a. Num a => Integer -> a
fromInteger Integer
i)

  signum :: IntervalSet r -> IntervalSet r
signum IntervalSet r
xs = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList ([Interval r] -> IntervalSet r) -> [Interval r] -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ do
    Interval r
x <- IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
xs
    Interval r
y <-
      [ if r -> Interval r -> Bool
forall r. Ord r => r -> Interval r -> Bool
Interval.member r
0 Interval r
x
        then r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton r
0
        else Interval r
forall r. Ord r => Interval r
Interval.empty
      , if Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null ((Extended r
0 Extended r -> Extended r -> Interval r
forall r. Ord r => Extended r -> Extended r -> Interval r
Interval.<..< Extended r
forall r. Extended r
inf) Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
x)
        then Interval r
forall r. Ord r => Interval r
Interval.empty
        else r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton r
1
      , if Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null ((-Extended r
forall r. Extended r
inf Extended r -> Extended r -> Interval r
forall r. Ord r => Extended r -> Extended r -> Interval r
Interval.<..< Extended r
0) Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
x)
        then Interval r
forall r. Ord r => Interval r
Interval.empty
        else r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton (-r
1)
      ]
    Interval r -> [Interval r]
forall (m :: * -> *) a. Monad m => a -> m a
return Interval r
y

-- | @recip (recip xs) == delete 0 xs@
instance forall r. (Real r, Fractional r) => Fractional (IntervalSet r) where
  fromRational :: Rational -> IntervalSet r
fromRational Rational
r = Interval r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r
singleton (Rational -> Interval r
forall a. Fractional a => Rational -> a
fromRational Rational
r)
  recip :: IntervalSet r -> IntervalSet r
recip IntervalSet r
xs = (Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
forall r.
Ord r =>
(Interval r -> Interval r) -> IntervalSet r -> IntervalSet r
lift1 Interval r -> Interval r
forall a. Fractional a => a -> a
recip (Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete (r -> Interval r
forall r. Ord r => r -> Interval r
Interval.singleton r
0) IntervalSet r
xs)

#if __GLASGOW_HASKELL__ >= 708
instance Ord r => GHCExts.IsList (IntervalSet r) where
  type Item (IntervalSet r) = Interval r
  fromList :: [Item (IntervalSet r)] -> IntervalSet r
fromList = [Item (IntervalSet r)] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList
  toList :: IntervalSet r -> [Item (IntervalSet r)]
toList = IntervalSet r -> [Item (IntervalSet r)]
forall r. Ord r => IntervalSet r -> [Interval r]
toList
#endif

-- -----------------------------------------------------------------------

-- | whole real number line (-∞, ∞)
whole :: Ord r => IntervalSet r
whole :: IntervalSet r
whole = Interval r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r
singleton (Interval r -> IntervalSet r) -> Interval r -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ Interval r
forall r. Ord r => Interval r
Interval.whole

-- | empty interval set
empty :: Ord r => IntervalSet r
empty :: IntervalSet r
empty = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet Map (Extended r) (Interval r)
forall k a. Map k a
Map.empty

-- | single interval
singleton :: Ord r => Interval r -> IntervalSet r
singleton :: Interval r -> IntervalSet r
singleton Interval r
i
  | Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = IntervalSet r
forall r. Ord r => IntervalSet r
empty
  | Bool
otherwise = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> Map (Extended r) (Interval r) -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ Extended r -> Interval r -> Map (Extended r) (Interval r)
forall k a. k -> a -> Map k a
Map.singleton (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Interval r
i

-- -----------------------------------------------------------------------

-- | Is the interval set empty?
null :: IntervalSet r -> Bool
null :: IntervalSet r -> Bool
null (IntervalSet Map (Extended r) (Interval r)
m) = Map (Extended r) (Interval r) -> Bool
forall k a. Map k a -> Bool
Map.null Map (Extended r) (Interval r)
m

-- | Is the element in the interval set?
member :: Ord r => r -> IntervalSet r -> Bool
member :: r -> IntervalSet r -> Bool
member r
x (IntervalSet Map (Extended r) (Interval r)
m) =
  case Extended r
-> Map (Extended r) (Interval r) -> Maybe (Extended r, Interval r)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (r -> Extended r
forall r. r -> Extended r
Finite r
x) Map (Extended r) (Interval r)
m of
    Maybe (Extended r, Interval r)
Nothing -> Bool
False
    Just (Extended r
_,Interval r
i) -> r -> Interval r -> Bool
forall r. Ord r => r -> Interval r -> Bool
Interval.member r
x Interval r
i

-- | Is the element not in the interval set?
notMember :: Ord r => r -> IntervalSet r -> Bool
notMember :: r -> IntervalSet r -> Bool
notMember r
x IntervalSet r
is = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ r
x r -> IntervalSet r -> Bool
forall r. Ord r => r -> IntervalSet r -> Bool
`member` IntervalSet r
is

-- | Is this a subset?
-- @(is1 \``isSubsetOf`\` is2)@ tells whether @is1@ is a subset of @is2@.
isSubsetOf :: Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf :: IntervalSet r -> IntervalSet r -> Bool
isSubsetOf IntervalSet r
is1 IntervalSet r
is2 = (Interval r -> Bool) -> [Interval r] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Interval r
i1 -> Interval r -> IntervalSet r -> Bool
forall r. Ord r => Interval r -> IntervalSet r -> Bool
f Interval r
i1 IntervalSet r
is2) (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is1)
  where
    f :: Interval r -> IntervalSet r -> Bool
f Interval r
i1 (IntervalSet Map (Extended r) (Interval r)
m) =
      case Extended r
-> Map (Extended r) (Interval r) -> Maybe (Extended r, Interval r)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i1) Map (Extended r) (Interval r)
m of
        Maybe (Extended r, Interval r)
Nothing -> Bool
False
        Just (Extended r
_,Interval r
i2) -> Interval r -> Interval r -> Bool
forall r. Ord r => Interval r -> Interval r -> Bool
Interval.isSubsetOf Interval r
i1 Interval r
i2

-- | Is this a proper subset? (/i.e./ a subset but not equal).
isProperSubsetOf :: Ord r => IntervalSet r -> IntervalSet r -> Bool
isProperSubsetOf :: IntervalSet r -> IntervalSet r -> Bool
isProperSubsetOf IntervalSet r
is1 IntervalSet r
is2 = IntervalSet r -> IntervalSet r -> Bool
forall r. Ord r => IntervalSet r -> IntervalSet r -> Bool
isSubsetOf IntervalSet r
is1 IntervalSet r
is2 Bool -> Bool -> Bool
&& IntervalSet r
is1 IntervalSet r -> IntervalSet r -> Bool
forall a. Eq a => a -> a -> Bool
/= IntervalSet r
is2

-- | convex hull of a set of intervals.
span :: Ord r => IntervalSet r -> Interval r
span :: IntervalSet r -> Interval r
span (IntervalSet Map (Extended r) (Interval r)
m) =
  case Map (Extended r) (Interval r)
-> Maybe (Interval r, Map (Extended r) (Interval r))
forall k a. Map k a -> Maybe (a, Map k a)
Map.minView Map (Extended r) (Interval r)
m of
    Maybe (Interval r, Map (Extended r) (Interval r))
Nothing -> Interval r
forall r. Ord r => Interval r
Interval.empty
    Just (Interval r
i1, Map (Extended r) (Interval r)
_) ->
      case Map (Extended r) (Interval r)
-> Maybe (Interval r, Map (Extended r) (Interval r))
forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map (Extended r) (Interval r)
m of
        Maybe (Interval r, Map (Extended r) (Interval r))
Nothing -> Interval r
forall r. Ord r => Interval r
Interval.empty
        Just (Interval r
i2, Map (Extended r) (Interval r)
_) ->
          (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i1) (Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i2)

-- -----------------------------------------------------------------------

-- | Complement the interval set.
complement :: Ord r => IntervalSet r -> IntervalSet r
complement :: IntervalSet r -> IntervalSet r
complement (IntervalSet Map (Extended r) (Interval r)
m) = [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromAscList ([Interval r] -> IntervalSet r) -> [Interval r] -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ (Extended r, Boundary) -> [Interval r] -> [Interval r]
forall r.
Ord r =>
(Extended r, Boundary) -> [Interval r] -> [Interval r]
f (Extended r
forall r. Extended r
NegInf,Boundary
Open) (Map (Extended r) (Interval r) -> [Interval r]
forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m)
  where
    f :: (Extended r, Boundary) -> [Interval r] -> [Interval r]
f (Extended r, Boundary)
prev [] = [ (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r, Boundary)
prev (Extended r
forall r. Extended r
PosInf,Boundary
Open) ]
    f (Extended r, Boundary)
prev (Interval r
i : [Interval r]
is) =
      case (Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i, Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i) of
        ((Extended r
lb, Boundary
in1), (Extended r
ub, Boundary
in2)) ->
          (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r, Boundary)
prev (Extended r
lb, Boundary -> Boundary
notB Boundary
in1) Interval r -> [Interval r] -> [Interval r]
forall a. a -> [a] -> [a]
: (Extended r, Boundary) -> [Interval r] -> [Interval r]
f (Extended r
ub, Boundary -> Boundary
notB Boundary
in2) [Interval r]
is

-- | Insert a new interval into the interval set.
insert :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert :: Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is | Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = IntervalSet r
is
insert Interval r
i (IntervalSet Map (Extended r) (Interval r)
is) = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> Map (Extended r) (Interval r) -> IntervalSet r
forall a b. (a -> b) -> a -> b
$
  case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
    Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Map (Extended r) (Interval r)
is of
    (Map (Extended r) (Interval r)
smaller, Maybe (Interval r)
m1, Map (Extended r) (Interval r)
xs) ->
      case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
    Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.upperBound Interval r
i) Map (Extended r) (Interval r)
xs of
        (Map (Extended r) (Interval r)
_, Maybe (Interval r)
m2, Map (Extended r) (Interval r)
larger) ->
          [Map (Extended r) (Interval r)] -> Map (Extended r) (Interval r)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ Map (Extended r) (Interval r)
smaller
          , case [Interval r] -> IntervalSet r
forall r. Ord r => [Interval r] -> IntervalSet r
fromList ([Interval r] -> IntervalSet r) -> [Interval r] -> IntervalSet r
forall a b. (a -> b) -> a -> b
$ Interval r
i Interval r -> [Interval r] -> [Interval r]
forall a. a -> [a] -> [a]
: Maybe (Interval r) -> [Interval r]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval r)
m1 [Interval r] -> [Interval r] -> [Interval r]
forall a. [a] -> [a] -> [a]
++ Maybe (Interval r) -> [Interval r]
forall a. Maybe a -> [a]
maybeToList Maybe (Interval r)
m2 of
              IntervalSet Map (Extended r) (Interval r)
m -> Map (Extended r) (Interval r)
m
          , Map (Extended r) (Interval r)
larger
          ]

-- | Delete an interval from the interval set.
delete :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete :: Interval r -> IntervalSet r -> IntervalSet r
delete Interval r
i IntervalSet r
is | Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
i = IntervalSet r
is
delete Interval r
i (IntervalSet Map (Extended r) (Interval r)
is) = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> Map (Extended r) (Interval r) -> IntervalSet r
forall a b. (a -> b) -> a -> b
$
  case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
    Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i) Map (Extended r) (Interval r)
is of
    (Map (Extended r) (Interval r)
smaller, Maybe (Interval r)
m1, Map (Extended r) (Interval r)
xs) ->
      case Extended r
-> Map (Extended r) (Interval r)
-> (Map (Extended r) (Interval r), Maybe (Interval r),
    Map (Extended r) (Interval r))
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.upperBound Interval r
i) Map (Extended r) (Interval r)
xs of
        (Map (Extended r) (Interval r)
_, Maybe (Interval r)
m2, Map (Extended r) (Interval r)
larger) ->
          [Map (Extended r) (Interval r)] -> Map (Extended r) (Interval r)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ Map (Extended r) (Interval r)
smaller
          , case Maybe (Interval r)
m1 of
              Maybe (Interval r)
Nothing -> Map (Extended r) (Interval r)
forall k a. Map k a
Map.empty
              Just Interval r
j -> [(Extended r, Interval r)] -> Map (Extended r) (Interval r)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
k, Interval r
k)
                | Interval r
i' <- [Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r
upTo Interval r
i, Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r
downTo Interval r
i], let k :: Interval r
k = Interval r
i' Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
j, Bool -> Bool
not (Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
k)
                ]
          , if
            | Just Interval r
j <- Maybe (Interval r)
m2, Interval r
j' <- Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r
downTo Interval r
i Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.intersection` Interval r
j, Bool -> Bool
not (Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
j') ->
                Extended r -> Interval r -> Map (Extended r) (Interval r)
forall k a. k -> a -> Map k a
Map.singleton (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
j') Interval r
j'
            | Bool
otherwise -> Map (Extended r) (Interval r)
forall k a. Map k a
Map.empty
          , Map (Extended r) (Interval r)
larger
          ]

-- | union of two interval sets
union :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union :: IntervalSet r -> IntervalSet r -> IntervalSet r
union is1 :: IntervalSet r
is1@(IntervalSet Map (Extended r) (Interval r)
m1) is2 :: IntervalSet r
is2@(IntervalSet Map (Extended r) (Interval r)
m2) =
  if Map (Extended r) (Interval r) -> Int
forall k a. Map k a -> Int
Map.size Map (Extended r) (Interval r)
m1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map (Extended r) (Interval r) -> Int
forall k a. Map k a -> Int
Map.size Map (Extended r) (Interval r)
m2
  then (IntervalSet r -> Interval r -> IntervalSet r)
-> IntervalSet r -> [Interval r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is) IntervalSet r
is1 (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is2)
  else (IntervalSet r -> Interval r -> IntervalSet r)
-> IntervalSet r -> [Interval r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
insert Interval r
i IntervalSet r
is) IntervalSet r
is2 (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is1)

-- | union of a list of interval sets
unions :: Ord r => [IntervalSet r] -> IntervalSet r
unions :: [IntervalSet r] -> IntervalSet r
unions = (IntervalSet r -> IntervalSet r -> IntervalSet r)
-> IntervalSet r -> [IntervalSet r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
union IntervalSet r
forall r. Ord r => IntervalSet r
empty

-- | intersection of two interval sets
intersection :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection :: IntervalSet r -> IntervalSet r -> IntervalSet r
intersection IntervalSet r
is1 IntervalSet r
is2 = IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference IntervalSet r
is1 (IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r
complement IntervalSet r
is2)

-- | intersection of a list of interval sets
intersections :: Ord r => [IntervalSet r] -> IntervalSet r
intersections :: [IntervalSet r] -> IntervalSet r
intersections = (IntervalSet r -> IntervalSet r -> IntervalSet r)
-> IntervalSet r -> [IntervalSet r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntervalSet r -> IntervalSet r -> IntervalSet r
forall r. Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
intersection IntervalSet r
forall r. Ord r => IntervalSet r
whole

-- | difference of two interval sets
difference :: Ord r => IntervalSet r -> IntervalSet r -> IntervalSet r
difference :: IntervalSet r -> IntervalSet r -> IntervalSet r
difference IntervalSet r
is1 IntervalSet r
is2 =
  (IntervalSet r -> Interval r -> IntervalSet r)
-> IntervalSet r -> [Interval r] -> IntervalSet r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntervalSet r
is Interval r
i -> Interval r -> IntervalSet r -> IntervalSet r
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
delete Interval r
i IntervalSet r
is) IntervalSet r
is1 (IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toList IntervalSet r
is2)

-- -----------------------------------------------------------------------

-- | Build a interval set from a list of intervals.
fromList :: Ord r => [Interval r] -> IntervalSet r
fromList :: [Interval r] -> IntervalSet r
fromList = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> ([Interval r] -> Map (Extended r) (Interval r))
-> [Interval r]
-> IntervalSet r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval r] -> Map (Extended r) (Interval r)
forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' ([Interval r] -> Map (Extended r) (Interval r))
-> ([Interval r] -> [Interval r])
-> [Interval r]
-> Map (Extended r) (Interval r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval r -> Interval r -> Ordering)
-> [Interval r] -> [Interval r]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB ((Extended r, Boundary) -> (Extended r, Boundary) -> Ordering)
-> (Interval r -> (Extended r, Boundary))
-> Interval r
-> Interval r
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound')

-- | Build a map from an ascending list of intervals.
-- /The precondition is not checked./
fromAscList :: Ord r => [Interval r] -> IntervalSet r
fromAscList :: [Interval r] -> IntervalSet r
fromAscList = Map (Extended r) (Interval r) -> IntervalSet r
forall r. Map (Extended r) (Interval r) -> IntervalSet r
IntervalSet (Map (Extended r) (Interval r) -> IntervalSet r)
-> ([Interval r] -> Map (Extended r) (Interval r))
-> [Interval r]
-> IntervalSet r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval r] -> Map (Extended r) (Interval r)
forall r. Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList'

fromAscList' :: Ord r => [Interval r] -> Map (Extended r) (Interval r)
fromAscList' :: [Interval r] -> Map (Extended r) (Interval r)
fromAscList' = [(Extended r, Interval r)] -> Map (Extended r) (Interval r)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Extended r, Interval r)] -> Map (Extended r) (Interval r))
-> ([Interval r] -> [(Extended r, Interval r)])
-> [Interval r]
-> Map (Extended r) (Interval r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval r -> (Extended r, Interval r))
-> [Interval r] -> [(Extended r, Interval r)]
forall a b. (a -> b) -> [a] -> [b]
map (\Interval r
i -> (Interval r -> Extended r
forall r. Interval r -> Extended r
Interval.lowerBound Interval r
i, Interval r
i)) ([Interval r] -> [(Extended r, Interval r)])
-> ([Interval r] -> [Interval r])
-> [Interval r]
-> [(Extended r, Interval r)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval r] -> [Interval r]
forall r. Ord r => [Interval r] -> [Interval r]
f
  where
    f :: Ord r => [Interval r] -> [Interval r]
    f :: [Interval r] -> [Interval r]
f [] = []
    f (Interval r
x : [Interval r]
xs) = Interval r -> [Interval r] -> [Interval r]
forall r. Ord r => Interval r -> [Interval r] -> [Interval r]
g Interval r
x [Interval r]
xs
    g :: Interval r -> [Interval r] -> [Interval r]
g Interval r
x [] = [Interval r
x | Bool -> Bool
not (Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
x)]
    g Interval r
x (Interval r
y : [Interval r]
ys)
      | Interval r -> Bool
forall r. Ord r => Interval r -> Bool
Interval.null Interval r
x = Interval r -> [Interval r] -> [Interval r]
g Interval r
y [Interval r]
ys
      | Interval r -> Interval r -> Bool
forall r. Ord r => Interval r -> Interval r -> Bool
Interval.isConnected Interval r
x Interval r
y = Interval r -> [Interval r] -> [Interval r]
g (Interval r
x Interval r -> Interval r -> Interval r
forall r. Ord r => Interval r -> Interval r -> Interval r
`Interval.hull` Interval r
y) [Interval r]
ys
      | Bool
otherwise = Interval r
x Interval r -> [Interval r] -> [Interval r]
forall a. a -> [a] -> [a]
: Interval r -> [Interval r] -> [Interval r]
g Interval r
y [Interval r]
ys

-- | Convert a interval set into a list of intervals.
toList :: Ord r => IntervalSet r -> [Interval r]
toList :: IntervalSet r -> [Interval r]
toList = IntervalSet r -> [Interval r]
forall r. Ord r => IntervalSet r -> [Interval r]
toAscList

-- | Convert a interval set into a list of intervals in ascending order.
toAscList :: Ord r => IntervalSet r -> [Interval r]
toAscList :: IntervalSet r -> [Interval r]
toAscList (IntervalSet Map (Extended r) (Interval r)
m) = Map (Extended r) (Interval r) -> [Interval r]
forall k a. Map k a -> [a]
Map.elems Map (Extended r) (Interval r)
m

-- | Convert a interval set into a list of intervals in descending order.
toDescList :: Ord r => IntervalSet r -> [Interval r]
toDescList :: IntervalSet r -> [Interval r]
toDescList (IntervalSet Map (Extended r) (Interval r)
m) = ((Extended r, Interval r) -> Interval r)
-> [(Extended r, Interval r)] -> [Interval r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extended r, Interval r) -> Interval r
forall a b. (a, b) -> b
snd ([(Extended r, Interval r)] -> [Interval r])
-> [(Extended r, Interval r)] -> [Interval r]
forall a b. (a -> b) -> a -> b
$ Map (Extended r) (Interval r) -> [(Extended r, Interval r)]
forall k a. Map k a -> [(k, a)]
Map.toDescList Map (Extended r) (Interval r)
m

-- -----------------------------------------------------------------------

splitLookupLE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE :: k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupLE k
k Map k v
m =
  case k -> Map k v -> (Map k v, Maybe v, Map k v)
forall k v. Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
Map.splitLookup k
k Map k v
m of
    (Map k v
smaller, Just v
v, Map k v
larger) -> (Map k v
smaller, v -> Maybe v
forall a. a -> Maybe a
Just v
v, Map k v
larger)
    (Map k v
smaller, Maybe v
Nothing, Map k v
larger) ->
      case Map k v -> Maybe (v, Map k v)
forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map k v
smaller of
        Just (v
v, Map k v
smaller') -> (Map k v
smaller', v -> Maybe v
forall a. a -> Maybe a
Just v
v, Map k v
larger)
        Maybe (v, Map k v)
Nothing -> (Map k v
smaller, Maybe v
forall a. Maybe a
Nothing, Map k v
larger)

{-
splitLookupGE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
splitLookupGE k m =
  case Map.splitLookup k m of
    (smaller, Just v, larger) -> (smaller, Just v, larger)
    (smaller, Nothing, larger) ->
      case Map.minView larger of
        Just (v, larger') -> (smaller, Just v, larger')
        Nothing -> (smaller, Nothing, larger)
-}

compareLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB :: (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
compareLB (Extended r
lb1, Boundary
lb1in) (Extended r
lb2, Boundary
lb2in) =
  -- inclusive lower endpoint shuold be considered smaller
  (Extended r
lb1 Extended r -> Extended r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Extended r
lb2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (Boundary
lb2in Boundary -> Boundary -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Boundary
lb1in)

upTo :: Ord r => Interval r -> Interval r
upTo :: Interval r -> Interval r
upTo Interval r
i =
  case Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.lowerBound' Interval r
i of
    (Extended r
NegInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.empty
    (Extended r
PosInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.whole
    (Finite r
lb, Boundary
incl) ->
      (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (Extended r
forall r. Extended r
NegInf, Boundary
Open) (r -> Extended r
forall r. r -> Extended r
Finite r
lb, Boundary -> Boundary
notB Boundary
incl)

downTo :: Ord r => Interval r -> Interval r
downTo :: Interval r -> Interval r
downTo Interval r
i =
  case Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
Interval.upperBound' Interval r
i of
    (Extended r
PosInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.empty
    (Extended r
NegInf, Boundary
_) -> Interval r
forall r. Ord r => Interval r
Interval.whole
    (Finite r
ub, Boundary
incl) ->
      (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
Interval.interval (r -> Extended r
forall r. r -> Extended r
Finite r
ub, Boundary -> Boundary
notB Boundary
incl) (Extended r
forall r. Extended r
PosInf, Boundary
Open)

notB :: Boundary -> Boundary
notB :: Boundary -> Boundary
notB = \case
  Boundary
Open   -> Boundary
Closed
  Boundary
Closed -> Boundary
Open