{-|
Module      : Interval Algebra Utilities
Description : Functions for operating on containers of Intervals.
Copyright   : (c) NoviSci, Inc 2020-2022
                  TargetRWE, 2023
License     : BSD3
Maintainer  : bsaul@novisci.com 2020-2022, bbrown@targetrwe.com 2023
Stability   : experimental

-}

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeFamilies        #-}

module IntervalAlgebra.IntervalUtilities
  (

    -- * Fold over sequential intervals
    combineIntervals
  , combineIntervalsFromSorted
  , rangeInterval

    -- * Combining intervals
  , (><)
  , (.+.)

    -- * Functions for manipulating intervals
  , lookback
  , lookahead

    -- * Gaps
  , gaps
  , pairGaps

    -- * Misc utilities
  , relations
  , intersect
  , clip
  , durations
  ) where

import           Control.Applicative            (Applicative (pure), liftA2,
                                                 (<$>), (<*>))
import qualified Control.Foldl                  as L
import           Control.Monad                  (Functor (fmap))
import           Data.Bool                      (Bool (..), not, otherwise,
                                                 (&&), (||))
import           Data.Eq                        (Eq ((==)))
import           Data.Foldable                  (Foldable (foldl', foldr, null, toList),
                                                 all, any, or)
import           Data.Function                  (flip, ($), (.))
import           Data.List                      (map, reverse, sortOn)
import           Data.Maybe                     (Maybe (..), mapMaybe, maybe,
                                                 maybeToList)
import           Data.Monoid                    (Monoid (mempty))
import           Data.Ord                       (Ord (max, min), (<), (>=))
import           Data.Semigroup                 (Semigroup ((<>)))
import           Data.Traversable               (Traversable (sequenceA))
import           Data.Tuple                     (fst, uncurry)
import           GHC.Int                        (Int)
import           GHC.Show                       (Show)
import           IntervalAlgebra.Core
import           IntervalAlgebra.PairedInterval (PairedInterval, equalPairData,
                                                 getPairData,
                                                 makePairedInterval)

{- $setup
>>> import GHC.List ( (++), zip )
>>> import IntervalAlgebra.IntervalDiagram
>>> import Prettyprinter ( pretty )
-}

-------------------------------------------------
-- Unexported utilties used in functions below --
-------------------------------------------------


-- | Gets the durations of gaps (via '(><)') between all pairs of the input.
pairGaps
  :: (Intervallic i, SizedIv (Interval a), Ord a, Ord (Moment (Interval a)))
  => [i a]
  -> [Maybe (Moment (Interval a))]
pairGaps :: [i a] -> [Maybe (Moment (Interval a))]
pairGaps [i a]
es = ((i a, i a) -> Maybe (Moment (Interval a)))
-> [(i a, i a)] -> [Maybe (Moment (Interval a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Interval a -> Moment (Interval a))
-> Maybe (Interval a) -> Maybe (Moment (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Interval a -> Moment (Interval a)
forall iv. SizedIv iv => iv -> Moment iv
duration (Maybe (Interval a) -> Maybe (Moment (Interval a)))
-> ((i a, i a) -> Maybe (Interval a))
-> (i a, i a)
-> Maybe (Moment (Interval a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> i a -> Maybe (Interval a))
-> (i a, i a) -> Maybe (Interval a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry i a -> i a -> Maybe (Interval a)
forall a (i :: * -> *).
(Iv (Interval a), Ord (Moment (Interval a)), SizedIv (Interval a),
 Intervallic i) =>
i a -> i a -> Maybe (Interval a)
(><)) ([i a] -> [(i a, i a)]
forall t. [t] -> [(t, t)]
pairs [i a]
es)
-- Generate all pair-wise combinations of a single list.
-- pairs :: [a] -> [(a, a)]
-- copied from the hgeometry library
-- (https://hackage.haskell.org/package/hgeometry-0.12.0.4/docs/src/Data.Geometry.Arrangement.Internal.html#allPairs)
 where
  pairs :: [t] -> [(t, t)]
pairs = [t] -> [(t, t)]
forall t. [t] -> [(t, t)]
go
   where
    go :: [t] -> [(t, t)]
go []       = []
    go (t
x : [t]
xs) = (t -> (t, t)) -> [t] -> [(t, t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
x, ) [t]
xs [(t, t)] -> [(t, t)] -> [(t, t)]
forall a. Semigroup a => a -> a -> a
<> [t] -> [(t, t)]
go [t]
xs

-- | Creates a new @Interval@ of a provided lookback duration ending at the
--   'begin' of the input interval.
--
-- >>> lookback 4 (beginerval 10 (1 :: Int))
-- (-3, 1)
lookback
  :: (Intervallic i, SizedIv (Interval a), Ord (Moment (Interval a)))
  => Moment (Interval a)   -- ^ lookback duration
  -> i a
  -> Interval a
lookback :: Moment (Interval a) -> i a -> Interval a
lookback Moment (Interval a)
d i a
x = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
d (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
x)

-- | Creates a new @Interval@ of a provided lookahead duration beginning at the
--   'end' of the input interval.
--
-- >>> lookahead 4 (beginerval 1 (1 :: Int))
-- (2, 6)
lookahead
  :: (Intervallic i, SizedIv (Interval a), Ord (Moment (Interval a)))
  => Moment (Interval a)   -- ^ lookahead duration
  -> i a
  -> Interval a
lookahead :: Moment (Interval a) -> i a -> Interval a
lookahead Moment (Interval a)
d i a
x = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
d (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
x)

-- | Returns a list of the 'IntervalRelation' between each consecutive pair of @i a@.
--
-- >>> relations [beginerval 1 0, beginerval 1 1]
-- [Meets]
-- >>> relations [beginerval 1 0, beginerval 1 1, beginerval 2 1]
-- [Meets,Starts]
-- >>> relations [beginerval 1 0]
-- []
relations
  :: ( Intervallic i
     , Iv (Interval a)
     )
  => [i a]
  -> [IntervalRelation]
relations :: [i a] -> [IntervalRelation]
relations []           = []
relations [i a
x]          = []
relations (i a
x : i a
y : [i a]
xs) = i a -> i a -> IntervalRelation
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
i0 a -> i1 a -> IntervalRelation
relate i a
x i a
y IntervalRelation -> [IntervalRelation] -> [IntervalRelation]
forall a. a -> [a] -> [a]
: [i a] -> [IntervalRelation]
forall (i :: * -> *) a.
(Intervallic i, Iv (Interval a)) =>
[i a] -> [IntervalRelation]
relations (i a
y i a -> [i a] -> [i a]
forall a. a -> [a] -> [a]
: [i a]
xs)

-- | Forms 'Just' a new interval from the intersection of two intervals,
--   provided the intervals are not 'disjoint'.
--
-- >>> intersect (bi 5 0) (bi 2 3)
-- Just (3, 5)
--
intersect
  :: (Intervallic i, SizedIv (Interval a), Ord a, Ord (Moment (Interval a))) => i a -> i a -> Maybe (Interval a)
intersect :: i a -> i a -> Maybe (Interval a)
intersect i a
x i a
y | ComparativePredicateOf2 (i a) (i a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint i a
x i a
y = Maybe (Interval a)
forall a. Maybe a
Nothing
              | Bool
otherwise    = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
(a, a) -> Interval a
safeInterval (a
b, a
e)
 where
  b :: a
b = a -> a -> a
forall a. Ord a => a -> a -> a
max (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
x) (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
y)
  e :: a
e = a -> a -> a
forall a. Ord a => a -> a -> a
min (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
y)

{- | Returns a list of intervals consisting of the gaps between
consecutive intervals in the input, after they have been sorted by
interval ordering.

>>> x1 = bi 4 1
>>> x2 = bi 4 8
>>> x3 = bi 3 11
>>> ivs = [x1, x2, x3]
>>> ivs
[(1, 5),(8, 12),(11, 14)]
>>> gaps ivs
[(5, 8)]
>>> pretty $ standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) []
 ----          <- [x1]
        ----   <- [x2]
           --- <- [x3]
==============

>>> x1 = bi 4 1
>>> x2 = bi 3 7
>>> x3 = bi 2 13
>>> ivs = [x1, x2, x3]
>>> ivs
[(1, 5),(7, 10),(13, 15)]
>>> gapIvs = gaps ivs
>>> gapIvs
[(5, 7),(10, 13)]
>>> :{
  pretty $
    standardExampleDiagram (zip ivs ["x1", "x2", "x3"]) [(gapIvs, "gapIvs")]
:}
 ----           <- [x1]
       ---      <- [x2]
             -- <- [x3]
     --   ---   <- [gapIvs]
===============
-}
gaps :: (
  SizedIv (Interval a),
  Intervallic i,
  Ord a,
  Ord (Moment (Interval a))
  ) =>
  [i a] ->
  [Interval a]
gaps :: [i a] -> [Interval a]
gaps [i a]
xs = ((i a, i a) -> Maybe (Interval a)) -> [(i a, i a)] -> [Interval a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((i a -> i a -> Maybe (Interval a))
-> (i a, i a) -> Maybe (Interval a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry i a -> i a -> Maybe (Interval a)
forall a (i :: * -> *).
(Iv (Interval a), Ord (Moment (Interval a)), SizedIv (Interval a),
 Intervallic i) =>
i a -> i a -> Maybe (Interval a)
(><)) ([(i a, i a)] -> [Interval a]) -> [(i a, i a)] -> [Interval a]
forall a b. (a -> b) -> a -> b
$ [i a] -> [(i a, i a)]
forall t. [t] -> [(t, t)]
pair ([i a] -> [(i a, i a)]) -> [i a] -> [(i a, i a)]
forall a b. (a -> b) -> a -> b
$ (i a -> Interval a) -> [i a] -> [i a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval [i a]
xs
  where pair :: [a] -> [(a, a)]
pair []           = []
        pair [a
x]          = []
        pair (a
x : a
y : [a]
ys) = (a
x, a
y) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [a] -> [(a, a)]
pair (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)

-- | Returns the 'duration' of each 'Intervallic i a' in the 'Functor' @f@.
--
-- >>> durations [bi 9 1, bi 10 2, bi 1 5 :: Interval Int]
-- [9,10,1]
--
durations :: (Functor f, Intervallic i, SizedIv (Interval a)) => f (i a) -> f (Moment (Interval a))
durations :: f (i a) -> f (Moment (Interval a))
durations = (i a -> Moment (Interval a)) -> f (i a) -> f (Moment (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Interval a -> Moment (Interval a)
forall iv. SizedIv iv => iv -> Moment iv
duration (Interval a -> Moment (Interval a))
-> (i a -> Interval a) -> i a -> Moment (Interval a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval)

-- | In the case that x y are not disjoint, clips y to the extent of x.
--
-- >>> clip (bi 5 0) ((bi 3 3) :: Interval Int)
-- Just (3, 5)
--
-- >>> clip (bi 3 0) ((bi 2 4) :: Interval Int)
-- Nothing
--
clip
  :: (Intervallic i0, Intervallic i1, SizedIv (Interval a), Ord a, Ord (Moment (Interval a)))
  => i0 a
  -> i1 a
  -> Maybe (Interval a)
clip :: i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
x i1 a
y
  | ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i0 a
x i1 a
y     = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
(a, a) -> Interval a
safeInterval (i1 a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i1 a
y, i0 a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i0 a
x)
  | ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy i0 a
x i1 a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
(a, a) -> Interval a
safeInterval (i0 a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i0 a
x, i1 a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i1 a
y)
  | ComparativePredicateOf2 (i0 a) (i1 a)
jx i0 a
x i1 a
y           = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x)
  | ComparativePredicateOf2 (i0 a) (i1 a)
jy i0 a
x i1 a
y           = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y)
  | Bool
otherwise        = Maybe (Interval a)
forall a. Maybe a
Nothing {- disjoint x y case -}
 where
  jy :: ComparativePredicateOf2 (i0 a) (i1 a)
jy = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
  jx :: ComparativePredicateOf2 (i0 a) (i1 a)
jx = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
{-# INLINABLE clip #-}

{- | Returns a list of intervals where any intervals that meet or share support
are combined into one interval. This function sorts the input. If you know the
input intervals are sorted, use @combineIntervalsLFromSorted@.

>>> x1 = bi 10 0
>>> x2 = bi 5 2
>>> x3 = bi 2 10
>>> x4 = bi 2 13
>>> ivs = [x1, x2, x3, x4]
>>> ivs
[(0, 10),(2, 7),(10, 12),(13, 15)]
>>> xComb = combineIntervals ivs
>>> xComb
[(0, 12),(13, 15)]
>>> :{
pretty $
  standardExampleDiagram
    (zip ivs ["x1", "x2", "x3", "x4"])
    [(xComb, "xComb")]
:}
----------      <- [x1]
  -----         <- [x2]
          --    <- [x3]
             -- <- [x4]
------------ -- <- [xComb]
===============
-}
combineIntervals :: (SizedIv (Interval a), Intervallic i, Ord a) => [i a] -> [Interval a]
combineIntervals :: [i a] -> [Interval a]
combineIntervals = [i a] -> [Interval a]
forall a (i :: * -> *).
(Ord a, Intervallic i, SizedIv (Interval a)) =>
[i a] -> [Interval a]
combineIntervalsFromSorted ([i a] -> [Interval a])
-> ([i a] -> [i a]) -> [i a] -> [Interval a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> Interval a) -> [i a] -> [i a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval

{- | Returns a list of intervals where any intervals that meet or share support
are combined into one interval. The operation is applied cumulatively, from left
to right, so
__to work properly, the input list should be sorted in increasing order__.

>>> combineIntervalsFromSorted [bi 10 0, bi 5 2, bi 2 10, bi 2 13]
[(0, 12),(13, 15)]

>>> combineIntervalsFromSorted [bi 10 0, bi 5 2, bi 0 8]
[(0, 10)]
-}
combineIntervalsFromSorted
  :: forall a i . (Ord a, Intervallic i, SizedIv (Interval a)) => [i a] -> [Interval a]
combineIntervalsFromSorted :: [i a] -> [Interval a]
combineIntervalsFromSorted = [Interval a] -> [Interval a]
forall a. [a] -> [a]
reverse ([Interval a] -> [Interval a])
-> ([i a] -> [Interval a]) -> [i a] -> [Interval a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Interval a] -> i a -> [Interval a])
-> [Interval a] -> [i a] -> [Interval a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Interval a] -> i a -> [Interval a]
forall (i1 :: * -> *) a.
(Intervallic i1, Ord a, SizedIv (Interval a)) =>
[Interval a] -> i1 a -> [Interval a]
op []
 where
  op :: [Interval a] -> i1 a -> [Interval a]
op []       i1 a
y = [i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y]
  op (Interval a
x : [Interval a]
xs) i1 a
y = if Interval a
x ComparativePredicateOf2 (Interval a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` i1 a
y
    -- Since x <= y, not (x `before` y) iff they meet or share support
    then Interval a
yiv Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: Interval a
x Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: [Interval a]
xs
    else Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval Interval a
x Interval a
yiv Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: [Interval a]
xs
    where yiv :: Interval a
yiv = i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y

{- | @Maybe@ form an @Interval a@ from @Control.Foldl t => t (Interval a)@
spanning the range of all intervals in the list, i.e. whose @begin@ is the
minimum of @begin@ across intervals in the list and whose @end@ is the maximum
of @end@.

>>> rangeInterval ([] :: [Interval Int])
Nothing

>>> x1 = bi 2 2
>>> x2 = bi 3 6
>>> x3 = bi 4 7
>>> ivs = [x1, x2, x3] :: [Interval Int]
>>> ivs
[(2, 4),(6, 9),(7, 11)]
>>> spanIv = rangeInterval ivs
>>> spanIv
Just (2, 11)
>>> :{
case spanIv of
  Nothing -> pretty ""
  (Just x) -> pretty $ standardExampleDiagram
    (zip (ivs ++ [x]) ["x1", "x2", "x3", "spanIv"])
    []
:}
  --        <- [x1]
      ---   <- [x2]
       ---- <- [x3]
  --------- <- [spanIv]
===========

>>> rangeInterval (Nothing :: Maybe (Interval Int))
Nothing
>>> rangeInterval (Just (bi 1 0))
Just (0, 1)
-}
rangeInterval :: (L.Foldable t, Ord a, SizedIv (Interval a)) => t (Interval a) -> Maybe (Interval a)
rangeInterval :: t (Interval a) -> Maybe (Interval a)
rangeInterval = Fold (Interval a) (Maybe (Interval a))
-> t (Interval a) -> Maybe (Interval a)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((Interval a -> Interval a -> Interval a)
-> Maybe (Interval a) -> Maybe (Interval a) -> Maybe (Interval a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval (Maybe (Interval a) -> Maybe (Interval a) -> Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a) -> Maybe (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold (Interval a) (Maybe (Interval a))
forall a. Ord a => Fold a (Maybe a)
L.minimum Fold (Interval a) (Maybe (Interval a) -> Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold (Interval a) (Maybe (Interval a))
forall a. Ord a => Fold a (Maybe a)
L.maximum)

  {- Combining intervals -}

-- | If @x@ is 'before' @y@, then form a new @Just Interval a@ from the
--   interval in the "gap" between @x@ and @y@ from the 'end' of @x@ to the
--   'begin' of @y@. Otherwise, 'Nothing'.
(><) :: (Iv (Interval a), Ord (Moment (Interval a)), SizedIv (Interval a), Intervallic i) => i a -> i a -> Maybe (Interval a)
>< :: i a -> i a -> Maybe (Interval a)
(><) i a
x i a
y
  | i a
x ComparativePredicateOf2 (i a) (i a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` i a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
(a, a) -> Interval a
safeInterval (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
x, i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
y)
  | Bool
otherwise    = Maybe (Interval a)
forall a. Maybe a
Nothing

-- | Maybe form a new @Interval a@ by the union of two @Interval a@s that 'meets'.
(.+.) :: (Iv (Interval a), Ord (Moment (Interval a)), SizedIv (Interval a), Intervallic i) => i a -> i a -> Maybe (Interval a)
.+. :: i a -> i a -> Maybe (Interval a)
(.+.) i a
x i a
y
  | i a
x ComparativePredicateOf2 (i a) (i a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`meets` i a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
(a, a) -> Interval a
safeInterval (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
x, i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
y)
  | Bool
otherwise   = Maybe (Interval a)
forall a. Maybe a
Nothing