module Data.Interval.Layers (
  Layers (Layers),
  Data.Interval.Layers.fromList,
  Data.Interval.Layers.toList,
  empty,
  singleton,
  insert,
  pile,
  squash,
  land,
  landAbove,
  thickness,
  thickest,
  dig,
  remove,
  (\-),
  baseline,
  difference,
  truncate,
  (\=),
  toStepFunction,
  integrate,

  -- ** Helper functions
  nestings,
) where

import Algebra.Lattice.Levitated (Levitated (Top))
import Data.Data (Data, Typeable)
import Data.Foldable qualified as Foldable
import Data.Group (Group (..))
import Data.Heap (Heap)
import Data.Heap qualified as Heap
import Data.Interval (
  Adjacency (..),
  Interval,
  OneOrTwo (..),
  pattern Whole,
  pattern (:---:),
  pattern (:|-|:),
 )
import Data.Interval qualified as Interval
import Data.Interval.Borel (Borel)
import Data.Interval.Borel qualified as Borel
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import GHC.Generics (Generic)
import Prelude hiding (truncate)

-- The 'Layers' of an ordered type @x@ are like the 'Borel' sets,
-- but that keeps track of how far each point has been "raised" in @y@.
newtype Layers x y = Layers (Map (Interval x) y)
  deriving (Layers x y -> Layers x y -> Bool
(Layers x y -> Layers x y -> Bool)
-> (Layers x y -> Layers x y -> Bool) -> Eq (Layers x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y. (Ord x, Eq y) => Layers x y -> Layers x y -> Bool
$c== :: forall x y. (Ord x, Eq y) => Layers x y -> Layers x y -> Bool
== :: Layers x y -> Layers x y -> Bool
$c/= :: forall x y. (Ord x, Eq y) => Layers x y -> Layers x y -> Bool
/= :: Layers x y -> Layers x y -> Bool
Eq, Eq (Layers x y)
Eq (Layers x y) =>
(Layers x y -> Layers x y -> Ordering)
-> (Layers x y -> Layers x y -> Bool)
-> (Layers x y -> Layers x y -> Bool)
-> (Layers x y -> Layers x y -> Bool)
-> (Layers x y -> Layers x y -> Bool)
-> (Layers x y -> Layers x y -> Layers x y)
-> (Layers x y -> Layers x y -> Layers x y)
-> Ord (Layers x y)
Layers x y -> Layers x y -> Bool
Layers x y -> Layers x y -> Ordering
Layers x y -> Layers x y -> Layers x y
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x y. (Ord x, Ord y) => Eq (Layers x y)
forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Bool
forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Ordering
forall x y.
(Ord x, Ord y) =>
Layers x y -> Layers x y -> Layers x y
$ccompare :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Ordering
compare :: Layers x y -> Layers x y -> Ordering
$c< :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Bool
< :: Layers x y -> Layers x y -> Bool
$c<= :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Bool
<= :: Layers x y -> Layers x y -> Bool
$c> :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Bool
> :: Layers x y -> Layers x y -> Bool
$c>= :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Bool
>= :: Layers x y -> Layers x y -> Bool
$cmax :: forall x y.
(Ord x, Ord y) =>
Layers x y -> Layers x y -> Layers x y
max :: Layers x y -> Layers x y -> Layers x y
$cmin :: forall x y.
(Ord x, Ord y) =>
Layers x y -> Layers x y -> Layers x y
min :: Layers x y -> Layers x y -> Layers x y
Ord, Int -> Layers x y -> ShowS
[Layers x y] -> ShowS
Layers x y -> String
(Int -> Layers x y -> ShowS)
-> (Layers x y -> String)
-> ([Layers x y] -> ShowS)
-> Show (Layers x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Ord x, Show x, Show y) => Int -> Layers x y -> ShowS
forall x y. (Ord x, Show x, Show y) => [Layers x y] -> ShowS
forall x y. (Ord x, Show x, Show y) => Layers x y -> String
$cshowsPrec :: forall x y. (Ord x, Show x, Show y) => Int -> Layers x y -> ShowS
showsPrec :: Int -> Layers x y -> ShowS
$cshow :: forall x y. (Ord x, Show x, Show y) => Layers x y -> String
show :: Layers x y -> String
$cshowList :: forall x y. (Ord x, Show x, Show y) => [Layers x y] -> ShowS
showList :: [Layers x y] -> ShowS
Show, (forall a b. (a -> b) -> Layers x a -> Layers x b)
-> (forall a b. a -> Layers x b -> Layers x a)
-> Functor (Layers x)
forall a b. a -> Layers x b -> Layers x a
forall a b. (a -> b) -> Layers x a -> Layers x b
forall x a b. a -> Layers x b -> Layers x a
forall x a b. (a -> b) -> Layers x a -> Layers x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall x a b. (a -> b) -> Layers x a -> Layers x b
fmap :: forall a b. (a -> b) -> Layers x a -> Layers x b
$c<$ :: forall x a b. a -> Layers x b -> Layers x a
<$ :: forall a b. a -> Layers x b -> Layers x a
Functor, (forall x. Layers x y -> Rep (Layers x y) x)
-> (forall x. Rep (Layers x y) x -> Layers x y)
-> Generic (Layers x y)
forall x. Rep (Layers x y) x -> Layers x y
forall x. Layers x y -> Rep (Layers x y) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x y x. Rep (Layers x y) x -> Layers x y
forall x y x. Layers x y -> Rep (Layers x y) x
$cfrom :: forall x y x. Layers x y -> Rep (Layers x y) x
from :: forall x. Layers x y -> Rep (Layers x y) x
$cto :: forall x y x. Rep (Layers x y) x -> Layers x y
to :: forall x. Rep (Layers x y) x -> Layers x y
Generic, Typeable, Typeable (Layers x y)
Typeable (Layers x y) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Layers x y -> c (Layers x y))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Layers x y))
-> (Layers x y -> Constr)
-> (Layers x y -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Layers x y)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Layers x y)))
-> ((forall b. Data b => b -> b) -> Layers x y -> Layers x y)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Layers x y -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Layers x y -> r)
-> (forall u. (forall d. Data d => d -> u) -> Layers x y -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Layers x y -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y))
-> Data (Layers x y)
Layers x y -> Constr
Layers x y -> DataType
(forall b. Data b => b -> b) -> Layers x y -> Layers x y
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Layers x y -> u
forall u. (forall d. Data d => d -> u) -> Layers x y -> [u]
forall x y. (Data x, Data y, Ord x) => Typeable (Layers x y)
forall x y. (Data x, Data y, Ord x) => Layers x y -> Constr
forall x y. (Data x, Data y, Ord x) => Layers x y -> DataType
forall x y.
(Data x, Data y, Ord x) =>
(forall b. Data b => b -> b) -> Layers x y -> Layers x y
forall x y u.
(Data x, Data y, Ord x) =>
Int -> (forall d. Data d => d -> u) -> Layers x y -> u
forall x y u.
(Data x, Data y, Ord x) =>
(forall d. Data d => d -> u) -> Layers x y -> [u]
forall x y r r'.
(Data x, Data y, Ord x) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
forall x y r r'.
(Data x, Data y, Ord x) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
forall x y (m :: * -> *).
(Data x, Data y, Ord x, Monad m) =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
forall x y (m :: * -> *).
(Data x, Data y, Ord x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
forall x y (c :: * -> *).
(Data x, Data y, Ord x) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Layers x y)
forall x y (c :: * -> *).
(Data x, Data y, Ord x) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Layers x y -> c (Layers x y)
forall x y (t :: * -> *) (c :: * -> *).
(Data x, Data y, Ord x, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Layers x y))
forall x y (t :: * -> * -> *) (c :: * -> *).
(Data x, Data y, Ord x, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Layers x y))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Layers x y)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Layers x y -> c (Layers x y)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Layers x y))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Layers x y))
$cgfoldl :: forall x y (c :: * -> *).
(Data x, Data y, Ord x) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Layers x y -> c (Layers x y)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Layers x y -> c (Layers x y)
$cgunfold :: forall x y (c :: * -> *).
(Data x, Data y, Ord x) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Layers x y)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Layers x y)
$ctoConstr :: forall x y. (Data x, Data y, Ord x) => Layers x y -> Constr
toConstr :: Layers x y -> Constr
$cdataTypeOf :: forall x y. (Data x, Data y, Ord x) => Layers x y -> DataType
dataTypeOf :: Layers x y -> DataType
$cdataCast1 :: forall x y (t :: * -> *) (c :: * -> *).
(Data x, Data y, Ord x, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Layers x y))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Layers x y))
$cdataCast2 :: forall x y (t :: * -> * -> *) (c :: * -> *).
(Data x, Data y, Ord x, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Layers x y))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Layers x y))
$cgmapT :: forall x y.
(Data x, Data y, Ord x) =>
(forall b. Data b => b -> b) -> Layers x y -> Layers x y
gmapT :: (forall b. Data b => b -> b) -> Layers x y -> Layers x y
$cgmapQl :: forall x y r r'.
(Data x, Data y, Ord x) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
$cgmapQr :: forall x y r r'.
(Data x, Data y, Ord x) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
$cgmapQ :: forall x y u.
(Data x, Data y, Ord x) =>
(forall d. Data d => d -> u) -> Layers x y -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Layers x y -> [u]
$cgmapQi :: forall x y u.
(Data x, Data y, Ord x) =>
Int -> (forall d. Data d => d -> u) -> Layers x y -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Layers x y -> u
$cgmapM :: forall x y (m :: * -> *).
(Data x, Data y, Ord x, Monad m) =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
$cgmapMp :: forall x y (m :: * -> *).
(Data x, Data y, Ord x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
$cgmapMo :: forall x y (m :: * -> *).
(Data x, Data y, Ord x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
Data)

instance (Ord x, Ord y, Semigroup y) => Semigroup (Layers x y) where
  (<>) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Layers x y -> Layers x y
  Layers Map (Interval x) y
s1 <> :: (Ord x, Ord y, Semigroup y) =>
Layers x y -> Layers x y -> Layers x y
<> Layers Map (Interval x) y
s2 =
    Map (Interval x) y -> Layers x y
forall x y. Map (Interval x) y -> Layers x y
Layers
      (Map (Interval x) y -> Layers x y)
-> ([(Interval x, y)] -> Map (Interval x) y)
-> [(Interval x, y)]
-> Layers x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval x, y)] -> Map (Interval x) y
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
      ([(Interval x, y)] -> Map (Interval x) y)
-> ([(Interval x, y)] -> [(Interval x, y)])
-> [(Interval x, y)]
-> Map (Interval x) y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc
      (Heap (Interval x, y) -> [(Interval x, y)])
-> ([(Interval x, y)] -> Heap (Interval x, y))
-> [(Interval x, y)]
-> [(Interval x, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList
      ([(Interval x, y)] -> Layers x y)
-> [(Interval x, y)] -> Layers x y
forall a b. (a -> b) -> a -> b
$ Map (Interval x) y -> [(Interval x, y)]
forall k a. Map k a -> [(k, a)]
Map.toAscList ((y -> y -> y)
-> Map (Interval x) y -> Map (Interval x) y -> Map (Interval x) y
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith y -> y -> y
forall a. Semigroup a => a -> a -> a
(<>) Map (Interval x) y
s1 Map (Interval x) y
s2)

instance (Ord x, Ord y, Semigroup y) => Monoid (Layers x y) where
  mempty :: (Ord x, Ord y, Semigroup y) => Layers x y
  mempty :: (Ord x, Ord y, Semigroup y) => Layers x y
mempty = Map (Interval x) y -> Layers x y
forall x y. Map (Interval x) y -> Layers x y
Layers Map (Interval x) y
forall a. Monoid a => a
mempty

instance (Ord x, Ord y, Group y) => Group (Layers x y) where
  invert :: (Ord x, Ord y, Group y) => Layers x y -> Layers x y
  invert :: (Ord x, Ord y, Group y) => Layers x y -> Layers x y
invert (Layers Map (Interval x) y
s) = Map (Interval x) y -> Layers x y
forall x y. Map (Interval x) y -> Layers x y
Layers ((y -> y) -> Map (Interval x) y -> Map (Interval x) y
forall a b. (a -> b) -> Map (Interval x) a -> Map (Interval x) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap y -> y
forall m. Group m => m -> m
invert Map (Interval x) y
s)

-- | A blank canvas.
empty :: Layers x y
empty :: forall x y. Layers x y
empty = Map (Interval x) y -> Layers x y
forall x y. Map (Interval x) y -> Layers x y
Layers Map (Interval x) y
forall k a. Map k a
Map.empty

-- | @singleton ix y@ is the rectangle with base @ix@ of thickness @y@.
singleton :: (Ord x) => Interval x -> y -> Layers x y
singleton :: forall x y. Ord x => Interval x -> y -> Layers x y
singleton Interval x
ix y
y = Map (Interval x) y -> Layers x y
forall x y. Map (Interval x) y -> Layers x y
Layers (Interval x -> y -> Map (Interval x) y
forall k a. k -> a -> Map k a
Map.singleton Interval x
ix y
y)

-- | Draw the 'Layers' of specified bases and thicknesses.
fromList :: (Ord x, Ord y, Semigroup y) => [(Interval x, y)] -> Layers x y
fromList :: forall x y.
(Ord x, Ord y, Semigroup y) =>
[(Interval x, y)] -> Layers x y
fromList = Map (Interval x) y -> Layers x y
forall x y. Map (Interval x) y -> Layers x y
Layers (Map (Interval x) y -> Layers x y)
-> ([(Interval x, y)] -> Map (Interval x) y)
-> [(Interval x, y)]
-> Layers x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval x, y)] -> Map (Interval x) y
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Interval x, y)] -> Map (Interval x) y)
-> ([(Interval x, y)] -> [(Interval x, y)])
-> [(Interval x, y)]
-> Map (Interval x) y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval x, y)] -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings

-- | Get all of the bases and thicknesses in the 'Layers'.
toList :: (Ord x) => Layers x y -> [(Interval x, y)]
toList :: forall x y. Ord x => Layers x y -> [(Interval x, y)]
toList (Layers Map (Interval x) y
s) = Map (Interval x) y -> [(Interval x, y)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Interval x) y
s

-- | Ignore the 'Layers' and focus only on whether points are 'Data.Interval.within'
-- any contained 'Interval' or not.
squash :: (Ord x) => Layers x y -> Borel x
squash :: forall x y. Ord x => Layers x y -> Borel x
squash (Layers Map (Interval x) y
s) = (Interval x -> Borel x) -> [Interval x] -> Borel x
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Interval x -> Borel x
forall x. Ord x => Interval x -> Borel x
Borel.singleton (Map (Interval x) y -> [Interval x]
forall k a. Map k a -> [k]
Map.keys Map (Interval x) y
s)

-- | Treating 'mempty' as sea level, consider the 'Borel' set of a provided
-- 'Layers' that is "land".
--
-- An improvement over 'squash' in that it will not return 'I.Whole'
-- if 'baseline' or some involved interval calculations have been used.
land :: (Ord x, Monoid y, Ord y) => Layers x y -> Borel x
land :: forall x y. (Ord x, Monoid y, Ord y) => Layers x y -> Borel x
land = y -> Layers x y -> Borel x
forall x y. (Ord x, Ord y) => y -> Layers x y -> Borel x
landAbove y
forall a. Monoid a => a
mempty

-- | Given a "sea level", consider the 'Borel' set of a provided 'Layers'
-- that is "land".
--
-- An improvement over 'squash' in that it will not return 'I.Whole'
-- if 'baseline' or some involved interval calculations have been used.
landAbove :: (Ord x, Ord y) => y -> Layers x y -> Borel x
landAbove :: forall x y. (Ord x, Ord y) => y -> Layers x y -> Borel x
landAbove y
sea (Layers Map (Interval x) y
s) = ((Interval x -> y -> Borel x) -> Map (Interval x) y -> Borel x)
-> Map (Interval x) y -> (Interval x -> y -> Borel x) -> Borel x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Interval x -> y -> Borel x) -> Map (Interval x) y -> Borel x
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Map (Interval x) y
s \Interval x
i y
y ->
  if y
y y -> y -> Bool
forall a. Ord a => a -> a -> Bool
> y
sea then Interval x -> Borel x
forall x. Ord x => Interval x -> Borel x
Borel.singleton Interval x
i else Borel x
forall x. Ord x => Borel x
Borel.empty

-- | @insert ix y l@ draws over @l@ a rectangle with base @ix@ of thickness @y@.
insert ::
  (Ord x, Ord y, Semigroup y) =>
  Interval x ->
  y ->
  Layers x y ->
  Layers x y
insert :: forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert Interval x
ix y
y = Layers x y -> Layers x y -> Layers x y
forall a. Semigroup a => a -> a -> a
(<>) (Interval x -> y -> Layers x y
forall x y. Ord x => Interval x -> y -> Layers x y
singleton Interval x
ix y
y)

-- | Flipped synonym for 'insert'.
-- Mnemonic: "pile" this much onto the existing 'Layers'
-- over the given 'Interval'.
pile ::
  (Ord x, Ord y, Semigroup y) =>
  y ->
  Interval x ->
  Layers x y ->
  Layers x y
pile :: forall x y.
(Ord x, Ord y, Semigroup y) =>
y -> Interval x -> Layers x y -> Layers x y
pile = (Interval x -> y -> Layers x y -> Layers x y)
-> y -> Interval x -> Layers x y -> Layers x y
forall a b c. (a -> b -> c) -> b -> a -> c
flip Interval x -> y -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert

-- | Take away a thickness over a given base from the 'Layers'.
dig :: (Ord x, Ord y, Group y) => y -> Interval x -> Layers x y -> Layers x y
dig :: forall x y.
(Ord x, Ord y, Group y) =>
y -> Interval x -> Layers x y -> Layers x y
dig y
y Interval x
ix = Interval x -> y -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert Interval x
ix (y -> y
forall m. Group m => m -> m
invert y
y)

-- | Completely remove an 'Interval' from the 'Layers'.
remove :: (Ord x, Ord y, Semigroup y) => Interval x -> Layers x y -> Layers x y
remove :: forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> Layers x y -> Layers x y
remove Interval x
ix (Layers Map (Interval x) y
s) = ((Layers x y -> Interval x -> y -> Layers x y)
 -> Map (Interval x) y -> Layers x y)
-> Map (Interval x) y
-> (Layers x y -> Interval x -> y -> Layers x y)
-> Layers x y
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Layers x y -> Interval x -> y -> Layers x y)
-> Layers x y -> Map (Interval x) y -> Layers x y
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
`Map.foldlWithKey'` Layers x y
forall x y. Layers x y
empty) Map (Interval x) y
s \Layers x y
acc Interval x
jx y
y ->
  Layers x y
acc Layers x y -> Layers x y -> Layers x y
forall a. Semigroup a => a -> a -> a
<> case Interval x
jx Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
Interval.\\ Interval x
ix of
    Maybe (OneOrTwo (Interval x))
Nothing -> Layers x y
forall a. Monoid a => a
mempty
    Just (One Interval x
kx) -> Interval x -> y -> Layers x y
forall x y. Ord x => Interval x -> y -> Layers x y
singleton Interval x
kx y
y
    Just (Two Interval x
kx Interval x
lx) -> [(Interval x, y)] -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
[(Interval x, y)] -> Layers x y
fromList [(Interval x
kx, y
y), (Interval x
lx, y
y)]

-- | Fliped infix version of 'remove'.
(\-) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Interval x -> Layers x y
\- :: forall x y.
(Ord x, Ord y, Semigroup y) =>
Layers x y -> Interval x -> Layers x y
(\-) = (Interval x -> Layers x y -> Layers x y)
-> Layers x y -> Interval x -> Layers x y
forall a b c. (a -> b -> c) -> b -> a -> c
flip Interval x -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> Layers x y -> Layers x y
remove

-- | Add the given thickness to every point.
baseline :: (Ord x, Ord y, Semigroup y) => y -> Layers x y -> Layers x y
baseline :: forall x y.
(Ord x, Ord y, Semigroup y) =>
y -> Layers x y -> Layers x y
baseline = Interval x -> y -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert Interval x
forall x. Ord x => Interval x
Whole

-- | "Excavate" the second argument from the first.
difference :: (Ord x, Ord y, Group y) => Layers x y -> Layers x y -> Layers x y
difference :: forall x y.
(Ord x, Ord y, Group y) =>
Layers x y -> Layers x y -> Layers x y
difference Layers x y
layers (Layers Map (Interval x) y
s) =
  ((Interval x, y) -> Layers x y -> Layers x y)
-> Layers x y -> [(Interval x, y)] -> Layers x y
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Interval x -> y -> Layers x y -> Layers x y)
-> (Interval x, y) -> Layers x y -> Layers x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((y -> Interval x -> Layers x y -> Layers x y)
-> Interval x -> y -> Layers x y -> Layers x y
forall a b c. (a -> b -> c) -> b -> a -> c
flip y -> Interval x -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Group y) =>
y -> Interval x -> Layers x y -> Layers x y
dig)) Layers x y
layers (Map (Interval x) y -> [(Interval x, y)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map (Interval x) y
s)

-- | Restrict the range of the 'Layers' to the given 'Interval'.
truncate ::
  (Ord x, Ord y, Semigroup y) => Interval x -> Layers x y -> Layers x y
truncate :: forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> Layers x y -> Layers x y
truncate Interval x
ix (Layers Map (Interval x) y
s) =
  ((Layers x y -> Interval x -> y -> Layers x y)
 -> Map (Interval x) y -> Layers x y)
-> Map (Interval x) y
-> (Layers x y -> Interval x -> y -> Layers x y)
-> Layers x y
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Layers x y -> Interval x -> y -> Layers x y)
-> Layers x y -> Map (Interval x) y -> Layers x y
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
`Map.foldlWithKey'` Layers x y
forall x y. Layers x y
empty) Map (Interval x) y
s \Layers x y
acc Interval x
jx y
y ->
    (Layers x y -> Layers x y)
-> (Interval x -> Layers x y -> Layers x y)
-> Maybe (Interval x)
-> Layers x y
-> Layers x y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Layers x y -> Layers x y
forall a. a -> a
id (Interval x -> y -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
`insert` y
y) (Interval x -> Interval x -> Maybe (Interval x)
forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
Interval.intersect Interval x
ix Interval x
jx) Layers x y
acc

-- | Flipped infix version of 'truncate'.
(\=) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Interval x -> Layers x y
\= :: forall x y.
(Ord x, Ord y, Semigroup y) =>
Layers x y -> Interval x -> Layers x y
(\=) = (Interval x -> Layers x y -> Layers x y)
-> Layers x y -> Interval x -> Layers x y
forall a b c. (a -> b -> c) -> b -> a -> c
flip Interval x -> Layers x y -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> Layers x y -> Layers x y
truncate

-- |
-- @'integrate' diff hgt ix l@ calculates the area under the 'Interval' @ix@
-- using the measure @diff@ of the interval multiplied by the height @hgt@
-- of the layers over each sub-interval in the layers.
integrate ::
  (Ord x, Ord y, Semigroup y, Num z) =>
  (x -> x -> z) ->
  (y -> z) ->
  Interval x ->
  Layers x y ->
  Maybe z
integrate :: forall x y z.
(Ord x, Ord y, Semigroup y, Num z) =>
(x -> x -> z) -> (y -> z) -> Interval x -> Layers x y -> Maybe z
integrate x -> x -> z
diff y -> z
hgt Interval x
ix Layers x y
layers =
  let Layers (Map (Interval x) y -> [(Interval x, y)]
forall k a. Map k a -> [(k, a)]
Map.assocs -> [(Interval x, y)]
s) = Layers x y
layers Layers x y -> Interval x -> Layers x y
forall x y.
(Ord x, Ord y, Semigroup y) =>
Layers x y -> Interval x -> Layers x y
\= Interval x
ix
      f :: (Interval x, y) -> Maybe z -> Maybe z
f (Interval x
jx, y
y) Maybe z
maccum = do
        z
acc <- Maybe z
maccum
        z
d <- (x -> x -> z) -> Interval x -> Maybe z
forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
Interval.measuring x -> x -> z
diff Interval x
jx
        z -> Maybe z
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (z -> Maybe z) -> z -> Maybe z
forall a b. (a -> b) -> a -> b
$ z
acc z -> z -> z
forall a. Num a => a -> a -> a
+ z
d z -> z -> z
forall a. Num a => a -> a -> a
* y -> z
hgt y
y
   in ((Interval x, y) -> Maybe z -> Maybe z)
-> Maybe z -> [(Interval x, y)] -> Maybe z
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Interval x, y) -> Maybe z -> Maybe z
f (z -> Maybe z
forall a. a -> Maybe a
Just z
0) [(Interval x, y)]
s

-- | Get the thickness of the 'Layers' at a point.
thickness :: (Ord x, Semigroup y) => Levitated x -> Layers x y -> Maybe y
thickness :: forall x y.
(Ord x, Semigroup y) =>
Levitated x -> Layers x y -> Maybe y
thickness Levitated x
x (Layers Map (Interval x) y
s) = case Interval x -> Map (Interval x) y -> Maybe (Interval x, y)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE (Levitated x
x Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
x) Map (Interval x) y
s of
  Just (Interval x
ix, y
y) | Levitated x
x Levitated x -> Interval x -> Bool
forall x. Ord x => Levitated x -> Interval x -> Bool
`Interval.within` Interval x
ix -> y -> Maybe y
forall a. a -> Maybe a
Just y
y
  Maybe (Interval x, y)
_ -> Maybe y
forall a. Maybe a
Nothing

-- | Where and how thick is the thickest 'Interval'?
thickest :: (Ord x, Ord y) => Layers x y -> Maybe (Interval x, y)
thickest :: forall x y. (Ord x, Ord y) => Layers x y -> Maybe (Interval x, y)
thickest (Layers Map (Interval x) y
s) =
  ((Maybe (Interval x, y)
  -> Interval x -> y -> Maybe (Interval x, y))
 -> Map (Interval x) y -> Maybe (Interval x, y))
-> Map (Interval x) y
-> (Maybe (Interval x, y)
    -> Interval x -> y -> Maybe (Interval x, y))
-> Maybe (Interval x, y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe (Interval x, y) -> Interval x -> y -> Maybe (Interval x, y))
-> Maybe (Interval x, y)
-> Map (Interval x) y
-> Maybe (Interval x, y)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
`Map.foldlWithKey'` Maybe (Interval x, y)
forall a. Maybe a
Nothing) Map (Interval x) y
s \Maybe (Interval x, y)
acc Interval x
ix y
y -> (Interval x, y) -> Maybe (Interval x, y)
forall a. a -> Maybe a
Just case Maybe (Interval x, y)
acc of
    Maybe (Interval x, y)
Nothing -> (Interval x
ix, y
y)
    Just (Interval x
_, y
y') | y
y y -> y -> Bool
forall a. Ord a => a -> a -> Bool
> y
y' -> (Interval x
ix, y
y)
    Just (Interval x
ix', y
y') -> (Interval x
ix', y
y')

-- | Convert the 'Layers' into a list of beginning-points and heights,
-- that define a step function piecewise.
toStepFunction :: (Ord x, Ord y, Monoid y) => Layers x y -> [(Levitated x, y)]
toStepFunction :: forall x y.
(Ord x, Ord y, Monoid y) =>
Layers x y -> [(Levitated x, y)]
toStepFunction = [(Interval x, y)] -> [(Levitated x, y)]
go ([(Interval x, y)] -> [(Levitated x, y)])
-> (Layers x y -> [(Interval x, y)])
-> Layers x y
-> [(Levitated x, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layers x y -> [(Interval x, y)]
forall x y. Ord x => Layers x y -> [(Interval x, y)]
Data.Interval.Layers.toList
 where
  go :: [(Interval x, y)] -> [(Levitated x, y)]
go = \case
    [(Levitated x
il :---: Levitated x
iu, y
iy), (j :: Interval x
j@(Levitated x
jl :---: Levitated x
Top), y
jy)]
      | Levitated x
iu Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
jl -> (Levitated x
il, y
iy) (Levitated x, y) -> [(Levitated x, y)] -> [(Levitated x, y)]
forall a. a -> [a] -> [a]
: [(Interval x, y)] -> [(Levitated x, y)]
go [(Interval x
j, y
jy)]
      | Bool
otherwise -> (Levitated x
il, y
iy) (Levitated x, y) -> [(Levitated x, y)] -> [(Levitated x, y)]
forall a. a -> [a] -> [a]
: (Levitated x
iu, y
forall a. Monoid a => a
mempty) (Levitated x, y) -> [(Levitated x, y)] -> [(Levitated x, y)]
forall a. a -> [a] -> [a]
: [(Interval x, y)] -> [(Levitated x, y)]
go [(Interval x
j, y
jy)]
    (Levitated x
il :---: Levitated x
iu, y
iy) : (j :: Interval x
j@(Levitated x
jl :---: Levitated x
_), y
jy) : [(Interval x, y)]
is
      | Levitated x
iu Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
jl -> (Levitated x
il, y
iy) (Levitated x, y) -> [(Levitated x, y)] -> [(Levitated x, y)]
forall a. a -> [a] -> [a]
: [(Interval x, y)] -> [(Levitated x, y)]
go ((Interval x
j, y
jy) (Interval x, y) -> [(Interval x, y)] -> [(Interval x, y)]
forall a. a -> [a] -> [a]
: [(Interval x, y)]
is)
      | Bool
otherwise -> (Levitated x
il, y
iy) (Levitated x, y) -> [(Levitated x, y)] -> [(Levitated x, y)]
forall a. a -> [a] -> [a]
: (Levitated x
iu, y
forall a. Monoid a => a
mempty) (Levitated x, y) -> [(Levitated x, y)] -> [(Levitated x, y)]
forall a. a -> [a] -> [a]
: [(Interval x, y)] -> [(Levitated x, y)]
go ((Interval x
j, y
jy) (Interval x, y) -> [(Interval x, y)] -> [(Interval x, y)]
forall a. a -> [a] -> [a]
: [(Interval x, y)]
is)
    [(Levitated x
il :---: Levitated x
iu, y
iy)] -> [(Levitated x
il, y
iy), (Levitated x
iu, y
forall a. Monoid a => a
mempty)]
    [] -> []

nestings ::
  (Ord x, Ord y, Semigroup y) =>
  [(Interval x, y)] ->
  [(Interval x, y)]
nestings :: forall x y.
(Ord x, Ord y, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings = Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc (Heap (Interval x, y) -> [(Interval x, y)])
-> ([(Interval x, y)] -> Heap (Interval x, y))
-> [(Interval x, y)]
-> [(Interval x, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList

nestingsAsc ::
  (Ord x, Ord y, Semigroup y) =>
  Heap (Interval x, y) ->
  [(Interval x, y)]
nestingsAsc :: forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc Heap (Interval x, y)
heap = case Maybe ((Interval x, y), (Interval x, y), Heap (Interval x, y))
firstTwo of
  Maybe ((Interval x, y), (Interval x, y), Heap (Interval x, y))
Nothing -> Heap (Interval x, y) -> [(Interval x, y)]
forall a. Heap a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Heap (Interval x, y)
heap
  Just ((Interval x
i', y
iy), (Interval x
j', y
jy), Heap (Interval x, y)
js) -> case Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
Interval.adjacency Interval x
i' Interval x
j' of
    Before Interval x
i Interval x
j -> (Interval x
i, y
iy) (Interval x, y) -> [(Interval x, y)] -> [(Interval x, y)]
forall a. a -> [a] -> [a]
: Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc ((Interval x, y) -> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Ord a => a -> Heap a -> Heap a
Heap.insert (Interval x
j, y
jy) Heap (Interval x, y)
js)
    Meets Interval x
i Interval x
j Interval x
k ->
      (Interval x
i, y
iy) (Interval x, y) -> [(Interval x, y)] -> [(Interval x, y)]
forall a. a -> [a] -> [a]
: Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc ([(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
jy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js)
    Overlaps Interval x
i Interval x
j Interval x
k ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
jy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Starts Interval x
i Interval x
j ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
j, y
jy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    During Interval x
i Interval x
j Interval x
k ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
jy), (Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
jy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Finishes Interval x
i Interval x
j ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Identical Interval x
i -> Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc ((Interval x, y) -> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Ord a => a -> Heap a -> Heap a
Heap.insert (Interval x
i, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy) Heap (Interval x, y)
js)
    FinishedBy Interval x
i Interval x
j ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Contains Interval x
i Interval x
j Interval x
k ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
iy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    StartedBy Interval x
i Interval x
j ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
j, y
iy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    OverlappedBy Interval x
i Interval x
j Interval x
k ->
      Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc do
        [(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
jy), (Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
iy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    MetBy Interval x
i Interval x
j Interval x
k ->
      (Interval x
i, y
jy) (Interval x, y) -> [(Interval x, y)] -> [(Interval x, y)]
forall a. a -> [a] -> [a]
: Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc ([(Interval x, y)] -> Heap (Interval x, y)
forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
j, y
iy y -> y -> y
forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
iy)] Heap (Interval x, y)
-> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js)
    After Interval x
i Interval x
j -> (Interval x
i, y
jy) (Interval x, y) -> [(Interval x, y)] -> [(Interval x, y)]
forall a. a -> [a] -> [a]
: Heap (Interval x, y) -> [(Interval x, y)]
forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc ((Interval x, y) -> Heap (Interval x, y) -> Heap (Interval x, y)
forall a. Ord a => a -> Heap a -> Heap a
Heap.insert (Interval x
j, y
iy) Heap (Interval x, y)
js)
 where
  firstTwo :: Maybe ((Interval x, y), (Interval x, y), Heap (Interval x, y))
firstTwo = do
    ((Interval x, y)
min1, Heap (Interval x, y)
heap') <- Heap (Interval x, y)
-> Maybe ((Interval x, y), Heap (Interval x, y))
forall a. Heap a -> Maybe (a, Heap a)
Heap.uncons Heap (Interval x, y)
heap
    ((Interval x, y)
min2, Heap (Interval x, y)
heap'') <- Heap (Interval x, y)
-> Maybe ((Interval x, y), Heap (Interval x, y))
forall a. Heap a -> Maybe (a, Heap a)
Heap.uncons Heap (Interval x, y)
heap'
    ((Interval x, y), (Interval x, y), Heap (Interval x, y))
-> Maybe ((Interval x, y), (Interval x, y), Heap (Interval x, y))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Interval x, y)
min1, (Interval x, y)
min2, Heap (Interval x, y)
heap'')