module Data.Interval.Layers (
  Layers,
  Data.Interval.Layers.fromList,
  Data.Interval.Layers.toList,
  empty,
  singleton,
  insert,
  pile,
  squash,
  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 I
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall x y. (Ord x, Eq y) => Layers x y -> Layers x y -> Bool
Eq, 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
min :: 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
max :: Layers x y -> Layers x y -> Layers x y
$cmax :: forall x y.
(Ord x, Ord y) =>
Layers x y -> Layers x y -> Layers x y
>= :: 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
$c< :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Bool
compare :: Layers x y -> Layers x y -> Ordering
$ccompare :: forall x y. (Ord x, Ord y) => Layers x y -> Layers x y -> Ordering
Ord, Int -> Layers x y -> ShowS
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
showList :: [Layers x y] -> ShowS
$cshowList :: forall x y. (Ord x, Show x, Show y) => [Layers x y] -> ShowS
show :: Layers x y -> String
$cshow :: forall x y. (Ord x, Show x, Show y) => Layers x y -> String
showsPrec :: Int -> Layers x y -> ShowS
$cshowsPrec :: forall x y. (Ord x, Show x, Show y) => Int -> Layers x y -> ShowS
Show, 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
<$ :: forall a b. a -> Layers x b -> Layers x a
$c<$ :: forall x a b. a -> Layers x b -> Layers x a
fmap :: forall a b. (a -> b) -> Layers x a -> Layers x b
$cfmap :: forall x a b. (a -> b) -> Layers x a -> Layers x b
Functor, 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
$cto :: forall x y x. Rep (Layers x y) x -> Layers x y
$cfrom :: forall x y x. Layers x y -> Rep (Layers x y) x
Generic, Typeable, Layers x y -> DataType
Layers x y -> Constr
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 {x} {y}. (Data x, Data y, Ord x) => Typeable (Layers x y)
forall x y. (Data x, Data y, Ord x) => Layers x y -> DataType
forall x y. (Data x, Data y, Ord x) => Layers x y -> Constr
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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (Layers x y))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Layers x y -> m (Layers x y)
$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)
gmapQi :: forall u. Int -> (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
gmapQ :: forall u. (forall d. Data d => d -> u) -> Layers x y -> [u]
$cgmapQ :: forall x y u.
(Data x, Data y, Ord x) =>
(forall d. Data d => d -> u) -> Layers x y -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Layers x y -> r
$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
gmapT :: (forall b. Data b => b -> b) -> Layers x y -> 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
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> 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))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Layers x y))
$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))
dataTypeOf :: Layers x y -> DataType
$cdataTypeOf :: forall x y. (Data x, Data y, Ord x) => Layers x y -> DataType
toConstr :: Layers x y -> Constr
$ctoConstr :: forall x y. (Data x, Data y, Ord x) => Layers x y -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
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)
$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)
Data)

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

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

instance (Ord x, Ord y, Group y) => Group (Layers x y) where
  invert :: Layers x y -> Layers x y
invert (Layers Map (Interval x) y
s) = forall x y. Map (Interval x) y -> Layers x y
Layers (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall x y. Map (Interval x) y -> Layers x y
Layers 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 = forall x y. Map (Interval x) y -> Layers x y
Layers (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 = forall x y. Map (Interval x) y -> Layers x y
Layers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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 '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) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall x. Ord x => Interval x -> Borel x
Borel.singleton (forall k a. Map k a -> [k]
Map.keys Map (Interval x) y
s)

-- | @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 = forall a. Semigroup a => a -> a -> a
(<>) (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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert Interval x
ix (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) =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
    ( \Layers x y
acc Interval x
jx y
y -> case Interval x
jx forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
I.\\ Interval x
ix of
        Maybe (OneOrTwo (Interval x))
Nothing -> Layers x y
acc
        Just (One Interval x
kx) -> Layers x y
acc forall a. Semigroup a => a -> a -> a
<> 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) -> Layers x y
acc forall a. Semigroup a => a -> a -> a
<> 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)]
    )
    forall x y. Layers x y
empty
    Map (Interval x) y
s

-- | 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
(\-) = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert 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) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall x y.
(Ord x, Ord y, Group y) =>
y -> Interval x -> Layers x y -> Layers x y
dig)) Layers x y
layers (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) =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
    ( \Layers x y
acc Interval x
jx y
y -> case forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
I.intersect Interval x
ix Interval x
jx of
        Maybe (Interval x)
Nothing -> Layers x y
acc
        Just Interval x
x -> forall x y.
(Ord x, Ord y, Semigroup y) =>
Interval x -> y -> Layers x y -> Layers x y
insert Interval x
x y
y Layers x y
acc
    )
    forall x y. Layers x y
empty
    Map (Interval x) y
s

-- | 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
(\=) = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 (forall k a. Map k a -> [(k, a)]
Map.assocs -> [(Interval x, y)]
s) = Layers x y
layers 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 <- forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
I.measuring x -> x -> z
diff Interval x
jx
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ z
acc forall a. Num a => a -> a -> a
+ z
d forall a. Num a => a -> a -> a
* y -> z
hgt y
y
   in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Interval x, y) -> Maybe z -> Maybe z
f (forall a. a -> Maybe a
Just z
0) [(Interval x, y)]
s

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

-- | 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) =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
    ( \Maybe (Interval x, y)
acc Interval x
ix y
y -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Maybe (Interval x, y)
acc of
        Maybe (Interval x, y)
Nothing -> (Interval x
ix, y
y)
        Just (Interval x
ix', y
y') -> if y
y forall a. Ord a => a -> a -> Bool
> y
y' then (Interval x
ix, y
y) else (Interval x
ix', y
y')
    )
    forall a. Maybe a
Nothing
    Map (Interval x) y
s

-- | 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 Layers x y
s = forall {x} {b}.
(Ord x, Monoid b) =>
[(Interval x, b)] -> [(Levitated x, b)]
g (forall x y. Ord x => Layers x y -> [(Interval x, y)]
Data.Interval.Layers.toList forall a b. (a -> b) -> a -> b
$ forall x y.
(Ord x, Ord y, Semigroup y) =>
y -> Layers x y -> Layers x y
baseline forall a. Monoid a => a
mempty Layers x y
s)
 where
  g :: [(Interval x, b)] -> [(Levitated x, b)]
g [(Levitated x
il :---: Levitated x
iu, b
iy), (j :: Interval x
j@(Levitated x
jl :---: Levitated x
Top), b
jy)]
    | Levitated x
iu forall a. Eq a => a -> a -> Bool
== Levitated x
jl = (Levitated x
il, b
iy) forall a. a -> [a] -> [a]
: [(Interval x, b)] -> [(Levitated x, b)]
g [(Interval x
j, b
jy)]
    | Bool
otherwise = (Levitated x
il, b
iy) forall a. a -> [a] -> [a]
: (Levitated x
iu, forall a. Monoid a => a
mempty) forall a. a -> [a] -> [a]
: [(Interval x, b)] -> [(Levitated x, b)]
g [(Interval x
j, b
jy)]
  g ((Levitated x
il :---: Levitated x
iu, b
iy) : (j :: Interval x
j@(Levitated x
jl :---: Levitated x
_), b
jy) : [(Interval x, b)]
is)
    | Levitated x
iu forall a. Eq a => a -> a -> Bool
== Levitated x
jl = (Levitated x
il, b
iy) forall a. a -> [a] -> [a]
: [(Interval x, b)] -> [(Levitated x, b)]
g ((Interval x
j, b
jy) forall a. a -> [a] -> [a]
: [(Interval x, b)]
is)
    | Bool
otherwise = (Levitated x
il, b
iy) forall a. a -> [a] -> [a]
: (Levitated x
iu, forall a. Monoid a => a
mempty) forall a. a -> [a] -> [a]
: [(Interval x, b)] -> [(Levitated x, b)]
g ((Interval x
j, b
jy) forall a. a -> [a] -> [a]
: [(Interval x, b)]
is)
  g [] = []
  g [(Levitated x
il :---: Levitated x
iu, b
iy)] = [(Levitated x
il, b
iy), (Levitated x
iu, 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 = forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> 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 forall x. Ord x => Interval x -> Interval x -> Adjacency x
I.adjacency Interval x
i' Interval x
j' of
    Before Interval x
i Interval x
j -> (Interval x
i, y
iy) forall a. a -> [a] -> [a]
: forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc (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) forall a. a -> [a] -> [a]
: forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc (forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
jy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js)
    Overlaps Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
jy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Starts Interval x
i Interval x
j ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
j, y
jy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    During Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
jy), (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
jy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Finishes Interval x
i Interval x
j ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Identical Interval x
i -> forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc (forall a. Ord a => a -> Heap a -> Heap a
Heap.insert (Interval x
i, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy) Heap (Interval x, y)
js)
    FinishedBy Interval x
i Interval x
j ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    Contains Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy), (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
iy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    StartedBy Interval x
i Interval x
j ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
j, y
iy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js
    OverlappedBy Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
i, y
jy), (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
iy)] 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) forall a. a -> [a] -> [a]
: forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc (forall a. Ord a => [a] -> Heap a
Heap.fromList [(Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy), (Interval x
k, y
iy)] forall a. Semigroup a => a -> a -> a
<> Heap (Interval x, y)
js)
    After Interval x
i Interval x
j -> (Interval x
i, y
jy) forall a. a -> [a] -> [a]
: forall x y.
(Ord x, Ord y, Semigroup y) =>
Heap (Interval x, y) -> [(Interval x, y)]
nestingsAsc (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') <- forall a. Heap a -> Maybe (a, Heap a)
Heap.uncons Heap (Interval x, y)
heap
    ((Interval x, y)
min2, Heap (Interval x, y)
heap'') <- forall a. Heap a -> Maybe (a, Heap a)
Heap.uncons Heap (Interval x, y)
heap'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Interval x, y)
min1, (Interval x, y)
min2, Heap (Interval x, y)
heap'')