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.Group (Group (..))
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.List (sortOn)
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, 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, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestingsAsc [(Interval x, y)]
s)

instance (Ord x, 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, 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, Semigroup y) => [(Interval x, y)] -> Layers x y
fromList :: forall x y. (Ord x, 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, 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, Semigroup y) =>
  Interval x ->
  y ->
  Layers x y ->
  Layers x y
insert :: forall x y.
(Ord x, 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, Semigroup y) =>
  y ->
  Interval x ->
  Layers x y ->
  Layers x y
pile :: forall x y.
(Ord x, 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, 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, Group y) => y -> Interval x -> Layers x y -> Layers x y
dig :: forall x y.
(Ord x, Group y) =>
y -> Interval x -> Layers x y -> Layers x y
dig y
y Interval x
ix = forall x y.
(Ord x, 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, Semigroup y) => Interval x -> Layers x y -> Layers x y
remove :: forall x y.
(Ord x, 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, 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, Semigroup y) => Layers x y -> Interval x -> Layers x y
\- :: forall x y.
(Ord x, 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, Semigroup y) =>
Interval x -> Layers x y -> Layers x y
remove

-- | Add the given thickness to every point.
baseline :: (Ord x, Semigroup y) => y -> Layers x y -> Layers x y
baseline :: forall x y. (Ord x, Semigroup y) => y -> Layers x y -> Layers x y
baseline = forall x y.
(Ord x, 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, Group y) => Layers x y -> Layers x y -> Layers x y
difference :: forall x y.
(Ord x, 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, 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, Semigroup y) => Interval x -> Layers x y -> Layers x y
truncate :: forall x y.
(Ord x, 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, 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, Semigroup y) => Layers x y -> Interval x -> Layers x y
\= :: forall x y.
(Ord x, 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, 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, Semigroup y, Num z) =>
  (x -> x -> z) ->
  (y -> z) ->
  Interval x ->
  Layers x y ->
  Maybe z
integrate :: forall x y z.
(Ord x, 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, 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, Monoid y) => Layers x y -> [(Levitated x, y)]
toStepFunction :: forall x y. (Ord x, 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, 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, Semigroup y) =>
  [(Interval x, y)] ->
  [(Interval x, y)]
nestings :: forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings = forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestingsAsc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst

nestingsAsc ::
  (Ord x, Semigroup y) =>
  [(Interval x, y)] ->
  [(Interval x, y)]
nestingsAsc :: forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestingsAsc = \case
  (Interval x
i', y
iy) : (Interval x
j', y
jy) : [(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, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings ((Interval x
j, y
jy) forall a. a -> [a] -> [a]
: [(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, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings ((Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy) forall a. a -> [a] -> [a]
: (Interval x
k, y
jy) forall a. a -> [a] -> [a]
: [(Interval x, y)]
js)
    Overlaps Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
iy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
k, y
jy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    Starts Interval x
i Interval x
j ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
jy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    During Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
k, y
jy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    Finishes Interval x
i Interval x
j ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
iy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    Identical Interval x
i -> forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings ((Interval x
i, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy) forall a. a -> [a] -> [a]
: [(Interval x, y)]
js)
    FinishedBy Interval x
i Interval x
j ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
iy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    Contains Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
iy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
k, y
iy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    StartedBy Interval x
i Interval x
j ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy)
          forall a. a -> [a] -> [a]
: [(Interval x, y)]
js
    OverlappedBy Interval x
i Interval x
j Interval x
k ->
      forall x y.
(Ord x, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings forall a b. (a -> b) -> a -> b
$
        (Interval x
i, y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy)
          forall a. a -> [a] -> [a]
: (Interval x
k, y
iy)
          forall a. a -> [a] -> [a]
: [(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, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings ((Interval x
j, y
iy forall a. Semigroup a => a -> a -> a
<> y
jy) forall a. a -> [a] -> [a]
: (Interval x
k, y
iy) forall a. a -> [a] -> [a]
: [(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, Semigroup y) =>
[(Interval x, y)] -> [(Interval x, y)]
nestings ((Interval x
j, y
iy) forall a. a -> [a] -> [a]
: [(Interval x, y)]
js)
  [(Interval x, y)]
x -> [(Interval x, y)]
x