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,
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)
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)
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 :: (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)
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
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
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)
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
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 ::
(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)
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
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)
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)]
(\-) :: (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
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
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)
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
(\=) :: (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 ::
(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
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
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')
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'')