{-# LANGUAGE FlexibleInstances,FlexibleContexts,FunctionalDependencies,MultiParamTypeClasses,CPP #-}
{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveTraversable #-}
module Data.Interval (
Interval(..),
IntersectionQuery(..),
Adjust(..),
TimeDifference(..),
NonNestedSeq(..),
intersects,properlyIntersects,contains,properlyContains,
covered,coveredBy,
overlap,properOverlap,
overlapTime,
fractionCovered,
prevailing,
intervalDuration,
maybeUnion,maybeIntersection,
hull,
hullSeq,
hullSeqNonNested,
without,
contiguous,components,componentsSeq,
sortByRight,
fromEndPoints,
splitIntersecting,
splitProperlyIntersecting,
ITree,
itree,
emptyITree,
insert,
hullOfTree,
invariant, toTree,
intersecting,intersectingProperly,
filterM,
joinSeq,
propSplit,
splitSeq
) where
import Data.Tree (Tree)
import qualified Data.Tree as Tree
import qualified Data.Sequence as Seq
import qualified Data.Monoid ((<>))
import Data.Filtrable (Filtrable(..))
import Data.Traversable (Traversable)
import Data.Foldable (toList, maximumBy, foldl', foldr')
import Data.Sequence (Seq, ViewL(EmptyL,(:<)), ViewR(EmptyR,(:>)), (><), (<|))
import Data.Function (on)
import Data.Functor.Identity (Identity(Identity, runIdentity))
import Data.Time (UTCTime, addUTCTime, diffUTCTime, utc, NominalDiffTime)
#if MIN_VERSION_time(1,9,0)
import Data.Time (LocalTime, utcToLocalTime, zonedTimeToLocalTime, diffLocalTime, addLocalTime)
#else
import Data.Time (LocalTime, utcToLocalTime, zonedTimeToLocalTime)
#endif
import Data.Time (ZonedTime, localTimeToUTC, zonedTimeToUTC)
import Control.Arrow ((***))
import Control.Applicative (Alternative, empty, (<|>))
class (Ord e) => Interval e i | i -> e where
lb :: i -> e
lb = forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall e i. Interval e i => i -> (e, e)
endPoints
ub :: i -> e
ub = forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall e i. Interval e i => i -> (e, e)
endPoints
endPoints :: i -> (e,e)
endPoints i
i = (forall e i. Interval e i => i -> e
lb i
i,forall e i. Interval e i => i -> e
ub i
i)
{-# MINIMAL (lb,ub) | endPoints #-}
instance (Ord e) => Interval e (e,e) where
endPoints :: (e, e) -> (e, e)
endPoints = forall a. a -> a
id
instance (Ord e) => Interval e (Identity e) where
lb :: Identity e -> e
lb = forall a. Identity a -> a
runIdentity
ub :: Identity e -> e
ub = forall a. Identity a -> a
runIdentity
class Foldable f => IntersectionQuery t e f | t -> f where
getIntersects :: (Interval e i, Interval e j) => i -> t j -> f j
getProperIntersects :: (Interval e i, Interval e j) => i -> t j -> f j
someIntersects :: (Interval e i, Interval e j) => i -> t j -> Bool
someProperlyIntersects :: (Interval e i, Interval e j) => i -> t j -> Bool
maybeBounds :: Interval e i => t i -> Maybe (e,e)
storedIntervals :: Interval e i => t i -> f i
instance Ord e => IntersectionQuery (ITree e) e Seq where
getIntersects :: forall i j. (Interval e i, Interval e j) => i -> ITree e j -> Seq j
getIntersects = forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getIntersectsIT
getProperIntersects :: forall i j. (Interval e i, Interval e j) => i -> ITree e j -> Seq j
getProperIntersects = forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getProperIntersectsIT
someIntersects :: forall i j. (Interval e i, Interval e j) => i -> ITree e j -> Bool
someIntersects = forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Bool
someIntersectsIT
someProperlyIntersects :: forall i j. (Interval e i, Interval e j) => i -> ITree e j -> Bool
someProperlyIntersects = forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Bool
someProperlyIntersectsIT
maybeBounds :: forall i. Interval e i => ITree e i -> Maybe (e, e)
maybeBounds = forall e i. Interval e i => ITree e i -> Maybe (e, e)
hullOfTree
storedIntervals :: forall i. Interval e i => ITree e i -> Seq i
storedIntervals = forall e i. ITree e i -> Seq i
iTreeContents
instance Ord e => IntersectionQuery NonNestedSeq e Seq where
getIntersects :: forall i j.
(Interval e i, Interval e j) =>
i -> NonNestedSeq j -> Seq j
getIntersects = (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. NonNestedSeq a -> Seq a
getSeq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Seq j
findSeq forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
intersects
getProperIntersects :: forall i j.
(Interval e i, Interval e j) =>
i -> NonNestedSeq j -> Seq j
getProperIntersects = (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. NonNestedSeq a -> Seq a
getSeq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Seq j
findSeq forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
properlyIntersects
someIntersects :: forall i j.
(Interval e i, Interval e j) =>
i -> NonNestedSeq j -> Bool
someIntersects = (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. NonNestedSeq a -> Seq a
getSeq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Bool
existsSeq forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
intersects
someProperlyIntersects :: forall i j.
(Interval e i, Interval e j) =>
i -> NonNestedSeq j -> Bool
someProperlyIntersects = (forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. NonNestedSeq a -> Seq a
getSeq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Bool
existsSeq forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
properlyIntersects
maybeBounds :: forall i. Interval e i => NonNestedSeq i -> Maybe (e, e)
maybeBounds = forall e i. Interval e i => Seq i -> Maybe (e, e)
hullSeqNonNested forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonNestedSeq a -> Seq a
getSeq
storedIntervals :: forall i. Interval e i => NonNestedSeq i -> Seq i
storedIntervals = forall a. NonNestedSeq a -> Seq a
getSeq
newtype NonNestedSeq a = FromSortedSeq {forall a. NonNestedSeq a -> Seq a
getSeq :: Seq a} deriving (NonNestedSeq a -> NonNestedSeq a -> Bool
forall a. Eq a => NonNestedSeq a -> NonNestedSeq a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNestedSeq a -> NonNestedSeq a -> Bool
$c/= :: forall a. Eq a => NonNestedSeq a -> NonNestedSeq a -> Bool
== :: NonNestedSeq a -> NonNestedSeq a -> Bool
$c== :: forall a. Eq a => NonNestedSeq a -> NonNestedSeq a -> Bool
Eq,NonNestedSeq a -> NonNestedSeq a -> Bool
NonNestedSeq a -> NonNestedSeq a -> Ordering
NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
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 {a}. Ord a => Eq (NonNestedSeq a)
forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Bool
forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Ordering
forall a.
Ord a =>
NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
min :: NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
$cmin :: forall a.
Ord a =>
NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
max :: NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
$cmax :: forall a.
Ord a =>
NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
>= :: NonNestedSeq a -> NonNestedSeq a -> Bool
$c>= :: forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Bool
> :: NonNestedSeq a -> NonNestedSeq a -> Bool
$c> :: forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Bool
<= :: NonNestedSeq a -> NonNestedSeq a -> Bool
$c<= :: forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Bool
< :: NonNestedSeq a -> NonNestedSeq a -> Bool
$c< :: forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Bool
compare :: NonNestedSeq a -> NonNestedSeq a -> Ordering
$ccompare :: forall a. Ord a => NonNestedSeq a -> NonNestedSeq a -> Ordering
Ord,Int -> NonNestedSeq a -> ShowS
forall a. Show a => Int -> NonNestedSeq a -> ShowS
forall a. Show a => [NonNestedSeq a] -> ShowS
forall a. Show a => NonNestedSeq a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonNestedSeq a] -> ShowS
$cshowList :: forall a. Show a => [NonNestedSeq a] -> ShowS
show :: NonNestedSeq a -> String
$cshow :: forall a. Show a => NonNestedSeq a -> String
showsPrec :: Int -> NonNestedSeq a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NonNestedSeq a -> ShowS
Show,forall a b. a -> NonNestedSeq b -> NonNestedSeq a
forall a b. (a -> b) -> NonNestedSeq a -> NonNestedSeq 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 -> NonNestedSeq b -> NonNestedSeq a
$c<$ :: forall a b. a -> NonNestedSeq b -> NonNestedSeq a
fmap :: forall a b. (a -> b) -> NonNestedSeq a -> NonNestedSeq b
$cfmap :: forall a b. (a -> b) -> NonNestedSeq a -> NonNestedSeq b
Functor,forall a. Eq a => a -> NonNestedSeq a -> Bool
forall a. Num a => NonNestedSeq a -> a
forall a. Ord a => NonNestedSeq a -> a
forall m. Monoid m => NonNestedSeq m -> m
forall a. NonNestedSeq a -> Bool
forall a. NonNestedSeq a -> Int
forall a. NonNestedSeq a -> [a]
forall a. (a -> a -> a) -> NonNestedSeq a -> a
forall m a. Monoid m => (a -> m) -> NonNestedSeq a -> m
forall b a. (b -> a -> b) -> b -> NonNestedSeq a -> b
forall a b. (a -> b -> b) -> b -> NonNestedSeq a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => NonNestedSeq a -> a
$cproduct :: forall a. Num a => NonNestedSeq a -> a
sum :: forall a. Num a => NonNestedSeq a -> a
$csum :: forall a. Num a => NonNestedSeq a -> a
minimum :: forall a. Ord a => NonNestedSeq a -> a
$cminimum :: forall a. Ord a => NonNestedSeq a -> a
maximum :: forall a. Ord a => NonNestedSeq a -> a
$cmaximum :: forall a. Ord a => NonNestedSeq a -> a
elem :: forall a. Eq a => a -> NonNestedSeq a -> Bool
$celem :: forall a. Eq a => a -> NonNestedSeq a -> Bool
length :: forall a. NonNestedSeq a -> Int
$clength :: forall a. NonNestedSeq a -> Int
null :: forall a. NonNestedSeq a -> Bool
$cnull :: forall a. NonNestedSeq a -> Bool
toList :: forall a. NonNestedSeq a -> [a]
$ctoList :: forall a. NonNestedSeq a -> [a]
foldl1 :: forall a. (a -> a -> a) -> NonNestedSeq a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NonNestedSeq a -> a
foldr1 :: forall a. (a -> a -> a) -> NonNestedSeq a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> NonNestedSeq a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> NonNestedSeq a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NonNestedSeq a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NonNestedSeq a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NonNestedSeq a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NonNestedSeq a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NonNestedSeq a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NonNestedSeq a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> NonNestedSeq a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> NonNestedSeq a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NonNestedSeq a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NonNestedSeq a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NonNestedSeq a -> m
fold :: forall m. Monoid m => NonNestedSeq m -> m
$cfold :: forall m. Monoid m => NonNestedSeq m -> m
Foldable,Functor NonNestedSeq
Foldable NonNestedSeq
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
NonNestedSeq (m a) -> m (NonNestedSeq a)
forall (f :: * -> *) a.
Applicative f =>
NonNestedSeq (f a) -> f (NonNestedSeq a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonNestedSeq a -> m (NonNestedSeq b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNestedSeq a -> f (NonNestedSeq b)
sequence :: forall (m :: * -> *) a.
Monad m =>
NonNestedSeq (m a) -> m (NonNestedSeq a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
NonNestedSeq (m a) -> m (NonNestedSeq a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonNestedSeq a -> m (NonNestedSeq b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonNestedSeq a -> m (NonNestedSeq b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NonNestedSeq (f a) -> f (NonNestedSeq a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NonNestedSeq (f a) -> f (NonNestedSeq a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNestedSeq a -> f (NonNestedSeq b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNestedSeq a -> f (NonNestedSeq b)
Traversable)
instance Semigroup (NonNestedSeq a) where
(FromSortedSeq Seq a
xs) <> :: NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
<> (FromSortedSeq Seq a
ys) = forall a. Seq a -> NonNestedSeq a
FromSortedSeq (Seq a
xs forall a. Semigroup a => a -> a -> a
<> Seq a
ys)
instance Monoid (NonNestedSeq a) where
mempty :: NonNestedSeq a
mempty = forall a. Seq a -> NonNestedSeq a
FromSortedSeq forall a. Monoid a => a
mempty
mappend :: NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Applicative NonNestedSeq where
pure :: forall a. a -> NonNestedSeq a
pure = forall a. Seq a -> NonNestedSeq a
FromSortedSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
(FromSortedSeq Seq (a -> b)
fs) <*> :: forall a b.
NonNestedSeq (a -> b) -> NonNestedSeq a -> NonNestedSeq b
<*> (FromSortedSeq Seq a
xs) = forall a. Seq a -> NonNestedSeq a
FromSortedSeq (Seq (a -> b)
fs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Seq a
xs)
instance Alternative NonNestedSeq where
empty :: forall a. NonNestedSeq a
empty = forall a. Monoid a => a
mempty
<|> :: forall a. NonNestedSeq a -> NonNestedSeq a -> NonNestedSeq a
(<|>) = forall a. Semigroup a => a -> a -> a
(<>)
instance Monad NonNestedSeq where
return :: forall a. a -> NonNestedSeq a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
(FromSortedSeq Seq a
xs) >>= :: forall a b.
NonNestedSeq a -> (a -> NonNestedSeq b) -> NonNestedSeq b
>>= a -> NonNestedSeq b
k = forall a. Seq a -> NonNestedSeq a
FromSortedSeq (Seq a
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. NonNestedSeq a -> Seq a
getSeqforall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> NonNestedSeq b
k))
instance Filtrable NonNestedSeq where
mapMaybe :: forall a b. (a -> Maybe b) -> NonNestedSeq a -> NonNestedSeq b
mapMaybe a -> Maybe b
f (FromSortedSeq Seq a
xs) = forall a. Seq a -> NonNestedSeq a
FromSortedSeq (forall (f :: * -> *) a b.
Filtrable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f Seq a
xs)
class TimeDifference t where
diffTime :: t -> t -> NominalDiffTime
addTime :: NominalDiffTime -> t -> t
instance TimeDifference UTCTime where
diffTime :: UTCTime -> UTCTime -> NominalDiffTime
diffTime = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime
addTime :: NominalDiffTime -> UTCTime -> UTCTime
addTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
#if MIN_VERSION_time(1,9,0)
instance TimeDifference LocalTime where
diffTime :: LocalTime -> LocalTime -> NominalDiffTime
diffTime = LocalTime -> LocalTime -> NominalDiffTime
diffLocalTime
addTime :: NominalDiffTime -> LocalTime -> LocalTime
addTime = NominalDiffTime -> LocalTime -> LocalTime
addLocalTime
#else
instance TimeDifference LocalTime where
diffTime x y = diffUTCTime (localTimeToUTC utc x) (localTimeToUTC utc y)
addTime x = utcToLocalTime utc . addUTCTime x . localTimeToUTC utc
#endif
instance TimeDifference ZonedTime where
diffTime :: ZonedTime -> ZonedTime -> NominalDiffTime
diffTime ZonedTime
x ZonedTime
y = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
x) (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
y)
addTime :: NominalDiffTime -> ZonedTime -> ZonedTime
addTime NominalDiffTime
x ZonedTime
z = ZonedTime
z {zonedTimeToLocalTime :: LocalTime
zonedTimeToLocalTime = forall t. TimeDifference t => NominalDiffTime -> t -> t
addTime NominalDiffTime
x (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
z)}
intervalDuration :: (TimeDifference t, Interval t i) => i -> NominalDiffTime
intervalDuration :: forall t i.
(TimeDifference t, Interval t i) =>
i -> NominalDiffTime
intervalDuration i
i = forall t. TimeDifference t => t -> t -> NominalDiffTime
diffTime (forall e i. Interval e i => i -> e
ub i
i) (forall e i. Interval e i => i -> e
lb i
i)
overlapTime :: (TimeDifference t, Interval t i, Interval t j) =>
i -> j -> NominalDiffTime
overlapTime :: forall t i j.
(TimeDifference t, Interval t i, Interval t j) =>
i -> j -> NominalDiffTime
overlapTime i
i j
j = let
x :: t
x = forall a. Ord a => a -> a -> a
max (forall e i. Interval e i => i -> e
lb i
i) (forall e i. Interval e i => i -> e
lb j
j)
y :: t
y = forall a. Ord a => a -> a -> a
min (forall e i. Interval e i => i -> e
ub i
i) (forall e i. Interval e i => i -> e
ub j
j)
in if t
x forall a. Ord a => a -> a -> Bool
< t
y then forall t. TimeDifference t => t -> t -> NominalDiffTime
diffTime t
y t
x else NominalDiffTime
0
prevailing :: (Interval t i, Interval t j, TimeDifference t) =>
i -> Seq (a,j) -> Maybe a
prevailing :: forall t i j a.
(Interval t i, Interval t j, TimeDifference t) =>
i -> Seq (a, j) -> Maybe a
prevailing i
i Seq (a, j)
js =
let ks :: Seq (a, j)
ks = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
intersects i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Seq (a, j)
js
in if forall a. Seq a -> Bool
Seq.null Seq (a, j)
ks
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall t i j.
(TimeDifference t, Interval t i, Interval t j) =>
i -> j -> NominalDiffTime
overlapTime i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)) Seq (a, j)
ks
class Interval e i => Adjust e i | i -> e where
adjustBounds :: (e -> e) -> (e -> e) -> i -> i
shift :: (e -> e) -> i -> i
shift e -> e
f = forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds e -> e
f e -> e
f
{-# MINIMAL (adjustBounds) #-}
instance Ord e => Adjust e (e,e) where
adjustBounds :: (e -> e) -> (e -> e) -> (e, e) -> (e, e)
adjustBounds e -> e
f e -> e
g (e
x,e
y) = (e -> e
f e
x,e -> e
g e
y)
maybeUnion :: (Interval e j, Interval e i, Adjust e i) => j -> i -> Maybe i
maybeUnion :: forall e j i.
(Interval e j, Interval e i, Adjust e i) =>
j -> i -> Maybe i
maybeUnion j
j i
i = if j
j forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` i
i
then forall a. a -> Maybe a
Just (forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds (forall a. Ord a => a -> a -> a
min (forall e i. Interval e i => i -> e
lb j
j)) (forall a. Ord a => a -> a -> a
max (forall e i. Interval e i => i -> e
ub j
j)) i
i)
else forall a. Maybe a
Nothing
maybeIntersection :: (Interval e j, Interval e i, Adjust e i) => j -> i -> Maybe i
maybeIntersection :: forall e j i.
(Interval e j, Interval e i, Adjust e i) =>
j -> i -> Maybe i
maybeIntersection j
j i
i = if j
j forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` i
i
then forall a. a -> Maybe a
Just (forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds (forall a. Ord a => a -> a -> a
max (forall e i. Interval e i => i -> e
lb j
j)) (forall a. Ord a => a -> a -> a
min (forall e i. Interval e i => i -> e
ub j
j)) i
i)
else forall a. Maybe a
Nothing
hull :: (Interval e i,Foldable f,Functor f) => f i -> Maybe (e,e)
hull :: forall e i (f :: * -> *).
(Interval e i, Foldable f, Functor f) =>
f i -> Maybe (e, e)
hull f i
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null f i
xs
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> e
lb f i
xs), forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> e
ub f i
xs))
without :: (Adjust e i,Interval e j) => i -> j -> [i]
without :: forall e i j. (Adjust e i, Interval e j) => i -> j -> [i]
without i
i j
j = if j
j forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`contains` i
i then [] else
if forall e i. Interval e i => i -> e
ub j
j forall a. Ord a => a -> a -> Bool
<= forall e i. Interval e i => i -> e
lb i
i Bool -> Bool -> Bool
|| forall e i. Interval e i => i -> e
lb j
j forall a. Ord a => a -> a -> Bool
>= forall e i. Interval e i => i -> e
ub i
i
then [i
i]
else if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`properlyContains` j
j
then [forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds forall a. a -> a
id (forall a b. a -> b -> a
const (forall e i. Interval e i => i -> e
lb j
j)) i
i,forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds (forall a b. a -> b -> a
const (forall e i. Interval e i => i -> e
ub j
j)) forall a. a -> a
id i
i]
else if forall e i. Interval e i => i -> e
lb j
j forall a. Ord a => a -> a -> Bool
<= forall e i. Interval e i => i -> e
lb i
i
then [forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds (forall a b. a -> b -> a
const (forall e i. Interval e i => i -> e
ub j
j)) forall a. a -> a
id i
i]
else [forall e i. Adjust e i => (e -> e) -> (e -> e) -> i -> i
adjustBounds forall a. a -> a
id (forall a b. a -> b -> a
const (forall e i. Interval e i => i -> e
lb j
j)) i
i]
contiguous :: Interval e i => [i] -> [[i]]
contiguous :: forall e i. Interval e i => [i] -> [[i]]
contiguous [] = []
contiguous (i
i:[i]
is) = (i
iforall a. a -> [a] -> [a]
:[i]
js) forall a. a -> [a] -> [a]
: forall e i. Interval e i => [i] -> [[i]]
contiguous [i]
ks where
([i]
js,[i]
ks) = forall e i. Interval e i => (e, e) -> [i] -> ([i], [i])
go (forall e i. Interval e i => i -> (e, e)
endPoints i
i) [i]
is
go :: Interval e i => (e,e) -> [i] -> ([i],[i])
go :: forall e i. Interval e i => (e, e) -> [i] -> ([i], [i])
go j :: (e, e)
j@(e
x,e
_y) ls :: [i]
ls@(i
l:[i]
ls') = if (e, e)
j forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` i
l
then let ([i]
foo,[i]
bar) = forall e i. Interval e i => (e, e) -> [i] -> ([i], [i])
go (e
x,forall e i. Interval e i => i -> e
ub i
l) [i]
ls' in (i
lforall a. a -> [a] -> [a]
:[i]
foo,[i]
bar)
else ([],[i]
ls)
go (e, e)
_ [] = ([],[])
components :: (Interval e i, Adjust e i) => [i] -> [i]
components :: forall e i. (Interval e i, Adjust e i) => [i] -> [i]
components [] = []
components (i
x:[i]
xs) = let cs :: [i]
cs = forall e i. (Interval e i, Adjust e i) => [i] -> [i]
components [i]
xs in case [i]
cs of
[] -> [i
x]
(i
c:[i]
cs') -> case forall e j i.
(Interval e j, Interval e i, Adjust e i) =>
j -> i -> Maybe i
maybeUnion i
x i
c of
Maybe i
Nothing -> i
xforall a. a -> [a] -> [a]
:[i]
cs
Just i
c' -> i
c'forall a. a -> [a] -> [a]
:[i]
cs'
componentsSeq :: (Interval e i, Adjust e i) => Seq i -> Seq i
componentsSeq :: forall e i. (Interval e i, Adjust e i) => Seq i -> Seq i
componentsSeq Seq i
ys = case forall a. Seq a -> ViewR a
Seq.viewr Seq i
ys of
ViewR i
EmptyR -> forall (f :: * -> *) a. Alternative f => f a
empty
Seq i
xs :> i
x -> forall {e} {t}. Adjust e t => Seq t -> t -> Seq t
c Seq i
xs i
x where
c :: Seq t -> t -> Seq t
c Seq t
bs t
a = case forall a. Seq a -> ViewR a
Seq.viewr Seq t
bs of
ViewR t
EmptyR -> forall a. a -> Seq a
Seq.singleton t
a
Seq t
bs' :> t
b -> case forall e j i.
(Interval e j, Interval e i, Adjust e i) =>
j -> i -> Maybe i
maybeUnion t
b t
a of
Maybe t
Nothing -> Seq t -> t -> Seq t
c Seq t
bs' t
b forall a. Seq a -> a -> Seq a
Seq.|> t
a
Just t
ab -> Seq t -> t -> Seq t
c Seq t
bs' t
ab
covered :: (Interval e i,Interval e j,Adjust e j) => i -> Seq j -> Seq j
covered :: forall e i j.
(Interval e i, Interval e j, Adjust e j) =>
i -> Seq j -> Seq j
covered i
i = forall e i. (Interval e i, Adjust e i) => Seq i -> Seq i
componentsSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i. Interval e i => Seq i -> Seq i
sortByRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Filtrable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (forall e j i.
(Interval e j, Interval e i, Adjust e i) =>
j -> i -> Maybe i
maybeIntersection i
i)
coveredBy :: (Interval e i, Interval e j, Foldable f) => i -> f j -> Bool
i
i coveredBy :: forall e i j (f :: * -> *).
(Interval e i, Interval e j, Foldable f) =>
i -> f j -> Bool
`coveredBy` f j
js = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[(e, e)]
remains j
j -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e i j. (Adjust e i, Interval e j) => i -> j -> [i]
without j
j forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(e, e)]
remains) [forall e i. Interval e i => i -> (e, e)
endPoints i
i] f j
js
fractionCovered :: (TimeDifference t, Interval t i, Interval t j, Fractional a) =>
j -> Seq i -> a
fractionCovered :: forall t i j a.
(TimeDifference t, Interval t i, Interval t j, Fractional a) =>
j -> Seq i -> a
fractionCovered j
i Seq i
xs = let
totalTime :: NominalDiffTime
totalTime = forall t i.
(TimeDifference t, Interval t i) =>
i -> NominalDiffTime
intervalDuration j
i
coveredTime :: NominalDiffTime
coveredTime = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NominalDiffTime
s (t, t)
j -> NominalDiffTime
s forall a. Num a => a -> a -> a
+ forall t i.
(TimeDifference t, Interval t i) =>
i -> NominalDiffTime
intervalDuration (t, t)
j) NominalDiffTime
0 forall a b. (a -> b) -> a -> b
$ forall e i j.
(Interval e i, Interval e j, Adjust e j) =>
i -> Seq j -> Seq j
covered j
i forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> (e, e)
endPoints Seq i
xs
in if NominalDiffTime
totalTimeforall a. Eq a => a -> a -> Bool
==NominalDiffTime
0 then a
1 else (forall a. Fractional a => Rational -> a
fromRationalforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Real a => a -> Rational
toRational) (NominalDiffTime
coveredTimeforall a. Fractional a => a -> a -> a
/NominalDiffTime
totalTime)
overlap :: (Interval e i, Interval e j) => i -> j -> Ordering
overlap :: forall e i j. (Interval e i, Interval e j) => i -> j -> Ordering
overlap i
i j
j = case (forall a. Ord a => a -> a -> Ordering
compare (forall e i. Interval e i => i -> e
ub i
i) (forall e i. Interval e i => i -> e
lb j
j),forall a. Ord a => a -> a -> Ordering
compare (forall e i. Interval e i => i -> e
ub j
j) (forall e i. Interval e i => i -> e
lb i
i)) of
(Ordering
LT,Ordering
_) -> Ordering
LT
(Ordering
_,Ordering
LT) -> Ordering
GT
(Ordering, Ordering)
_ -> Ordering
EQ
properOverlap :: (Interval e i, Interval e j) => i -> j -> Ordering
properOverlap :: forall e i j. (Interval e i, Interval e j) => i -> j -> Ordering
properOverlap i
i j
j = case ((forall e i. Interval e i => i -> e
ub i
i) forall a. Ord a => a -> a -> Bool
<= (forall e i. Interval e i => i -> e
lb j
j),(forall e i. Interval e i => i -> e
ub j
j) forall a. Ord a => a -> a -> Bool
<= (forall e i. Interval e i => i -> e
lb i
i)) of
(Bool
True,Bool
_) -> Ordering
LT
(Bool
_,Bool
True) -> Ordering
GT
(Bool, Bool)
_ -> Ordering
EQ
intersects :: (Interval e i,Interval e j) => i -> j -> Bool
i
i intersects :: forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` j
j = Bool -> Bool
not (forall e i. Interval e i => i -> e
ub i
i forall a. Ord a => a -> a -> Bool
< forall e i. Interval e i => i -> e
lb j
j Bool -> Bool -> Bool
|| forall e i. Interval e i => i -> e
ub j
j forall a. Ord a => a -> a -> Bool
< forall e i. Interval e i => i -> e
lb i
i)
properlyIntersects :: (Interval e i,Interval e j) => i -> j -> Bool
i
i properlyIntersects :: forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`properlyIntersects` j
j = Bool -> Bool
not (forall e i. Interval e i => i -> e
ub i
i forall a. Ord a => a -> a -> Bool
<= forall e i. Interval e i => i -> e
lb j
j Bool -> Bool -> Bool
|| forall e i. Interval e i => i -> e
ub j
j forall a. Ord a => a -> a -> Bool
<= forall e i. Interval e i => i -> e
lb i
i)
contains :: (Interval e i,Interval e j) => i -> j -> Bool
i
i contains :: forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`contains` j
j = forall e i. Interval e i => i -> e
lb i
i forall a. Ord a => a -> a -> Bool
<= forall e i. Interval e i => i -> e
lb j
j Bool -> Bool -> Bool
&& forall e i. Interval e i => i -> e
ub j
j forall a. Ord a => a -> a -> Bool
<= forall e i. Interval e i => i -> e
ub i
i
properlyContains :: (Interval e i,Interval e j) => i -> j -> Bool
i
i properlyContains :: forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`properlyContains` j
j = forall e i. Interval e i => i -> e
lb i
i forall a. Ord a => a -> a -> Bool
< forall e i. Interval e i => i -> e
lb j
j Bool -> Bool -> Bool
&& forall e i. Interval e i => i -> e
ub i
i forall a. Ord a => a -> a -> Bool
> forall e i. Interval e i => i -> e
ub j
j
fromEndPoints :: (Ord e) => [e] -> Seq (e,e)
fromEndPoints :: forall e. Ord e => [e] -> Seq (e, e)
fromEndPoints [] = forall (f :: * -> *) a. Alternative f => f a
empty
fromEndPoints [e
_] = forall (f :: * -> *) a. Alternative f => f a
empty
fromEndPoints [e
x,e
y] = if e
x forall a. Ord a => a -> a -> Bool
<= e
y then forall a. a -> Seq a
Seq.singleton (e
x,e
y) else forall a. HasCallStack => String -> a
error String
"unsorted list"
fromEndPoints (e
x:[e]
xs) = let s :: Seq (e, e)
s = forall e. Ord e => [e] -> Seq (e, e)
fromEndPoints [e]
xs in case forall a. Seq a -> ViewL a
Seq.viewl Seq (e, e)
s of
(e
y,e
_) :< Seq (e, e)
_ -> (e
x,e
y) forall a. a -> Seq a -> Seq a
<| Seq (e, e)
s
ViewL (e, e)
EmptyL -> forall a. HasCallStack => String -> a
error String
"Intervals.fromEndPoints: this should never happen"
sortByRight :: (Interval e i) => Seq i -> Seq i
sortByRight :: forall e i. Interval e i => Seq i -> Seq i
sortByRight = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (\i
i i
j -> forall a. Ord a => a -> a -> Ordering
compare (forall e i. Interval e i => i -> e
ub i
i) (forall e i. Interval e i => i -> e
ub i
j) forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare (forall e i. Interval e i => i -> e
lb i
j) (forall e i. Interval e i => i -> e
lb i
i))
intersecting :: (Interval e i,Interval e j) => j -> Seq i -> Seq i
intersecting :: forall e i j. (Interval e i, Interval e j) => j -> Seq i -> Seq i
intersecting j
j = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
intersects j
j)
intersectingProperly :: (Interval e i,Interval e j) => j -> Seq i -> Seq i
intersectingProperly :: forall e i j. (Interval e i, Interval e j) => j -> Seq i -> Seq i
intersectingProperly j
j = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
properlyIntersects j
j)
hullSeq :: Interval e i => Seq i -> Maybe (e,e)
hullSeq :: forall e i. Interval e i => Seq i -> Maybe (e, e)
hullSeq Seq i
xs = case forall a. Seq a -> ViewR a
Seq.viewr Seq i
xs of
ViewR i
EmptyR -> forall a. Maybe a
Nothing
Seq i
_others :> i
rightmost -> forall a. a -> Maybe a
Just (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> e
lb Seq i
xs),forall e i. Interval e i => i -> e
ub i
rightmost)
splitIntersecting :: (Interval e i, Interval e j) => i -> [j] -> ([j],[j])
splitIntersecting :: forall e i j.
(Interval e i, Interval e j) =>
i -> [j] -> ([j], [j])
splitIntersecting i
_ [] = ([],[])
splitIntersecting i
i js :: [j]
js@(j
j:[j]
js') = case i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Ordering
`overlap` j
j of
Ordering
GT -> forall e i j.
(Interval e i, Interval e j) =>
i -> [j] -> ([j], [j])
splitIntersecting i
i [j]
js'
Ordering
LT -> ([],[j]
js)
Ordering
EQ -> let
keep :: Bool
keep = forall e i. Interval e i => i -> e
ub j
j forall a. Ord a => a -> a -> Bool
>= forall e i. Interval e i => i -> e
ub i
i
([j]
block,[j]
notIntersecting) = forall e i j.
(Interval e i, Interval e j) =>
i -> [j] -> ([j], [j])
splitIntersecting i
i [j]
js'
in (j
jforall a. a -> [a] -> [a]
:[j]
block,if Bool
keep then j
jforall a. a -> [a] -> [a]
:[j]
notIntersecting else [j]
notIntersecting)
splitProperlyIntersecting :: (Interval e i, Interval e j) => i -> [j] -> ([j],[j])
splitProperlyIntersecting :: forall e i j.
(Interval e i, Interval e j) =>
i -> [j] -> ([j], [j])
splitProperlyIntersecting i
_ [] = ([],[])
splitProperlyIntersecting i
i js :: [j]
js@(j
j:[j]
js') = case i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Ordering
`properOverlap` j
j of
Ordering
GT -> forall e i j.
(Interval e i, Interval e j) =>
i -> [j] -> ([j], [j])
splitProperlyIntersecting i
i [j]
js'
Ordering
LT -> ([],[j]
js)
Ordering
EQ -> let
keep :: Bool
keep = forall e i. Interval e i => i -> e
ub j
j forall a. Ord a => a -> a -> Bool
> forall e i. Interval e i => i -> e
ub i
i
([j]
block,[j]
notIntersecting) = forall e i j.
(Interval e i, Interval e j) =>
i -> [j] -> ([j], [j])
splitProperlyIntersecting i
i [j]
js'
in (j
jforall a. a -> [a] -> [a]
:[j]
block,if Bool
keep then j
jforall a. a -> [a] -> [a]
:[j]
notIntersecting else [j]
notIntersecting)
data ITree e i = Bin (Seq i) | Split (Seq i) e e e (ITree e i) (ITree e i)
instance Functor (ITree e) where
fmap :: forall a b. (a -> b) -> ITree e a -> ITree e b
fmap a -> b
f (Bin Seq a
xs) = forall e i. Seq i -> ITree e i
Bin (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs)
fmap a -> b
f (Split Seq a
up e
x e
y e
z ITree e a
left ITree e a
right) = forall e i.
Seq i -> e -> e -> e -> ITree e i -> ITree e i -> ITree e i
Split (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
up) e
x e
y e
z (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ITree e a
left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ITree e a
right)
instance Foldable (ITree e) where
foldMap :: forall m a. Monoid m => (a -> m) -> ITree e a -> m
foldMap a -> m
f (Bin Seq a
xs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Seq a
xs
foldMap a -> m
f (Split Seq a
up e
_ e
_ e
_ ITree e a
left ITree e a
right) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ITree e a
left forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Seq a
up forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ITree e a
right
emptyITree :: ITree e i
emptyITree :: forall e i. ITree e i
emptyITree = forall e i. Seq i -> ITree e i
Bin forall (f :: * -> *) a. Alternative f => f a
empty
hullOfTree :: (Interval e i) => ITree e i -> Maybe (e,e)
hullOfTree :: forall e i. Interval e i => ITree e i -> Maybe (e, e)
hullOfTree (Bin Seq i
xs) = if forall a. Seq a -> Bool
Seq.null Seq i
xs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> e
lb Seq i
xs),forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> e
ub Seq i
xs))
hullOfTree (Split Seq i
_ e
x e
_ e
y ITree e i
_ ITree e i
_) = forall a. a -> Maybe a
Just (e
x,e
y)
iTreeContents :: ITree e i -> Seq i
iTreeContents :: forall e i. ITree e i -> Seq i
iTreeContents (Bin Seq i
xs) = Seq i
xs
iTreeContents (Split Seq i
cross e
_ e
_ e
_ ITree e i
left ITree e i
right) = (forall e i. ITree e i -> Seq i
iTreeContents ITree e i
left) forall a. Semigroup a => a -> a -> a
<> Seq i
cross forall a. Semigroup a => a -> a -> a
<> (forall e i. ITree e i -> Seq i
iTreeContents ITree e i
right)
invariant :: Interval e i => ITree e i -> Bool
invariant :: forall e i. Interval e i => ITree e i -> Bool
invariant (Bin Seq i
_) = Bool
True
invariant (Split Seq i
up e
x e
y e
z ITree e i
left ITree e i
right) = e
x forall a. Ord a => a -> a -> Bool
<= e
y Bool -> Bool -> Bool
&& e
y forall a. Ord a => a -> a -> Bool
<= e
z Bool -> Bool -> Bool
&& Bool
invUp Bool -> Bool -> Bool
&& Bool
invLeft Bool -> Bool -> Bool
&& Bool
invRight where
invUp :: Bool
invUp = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
intersects (forall a. a -> Identity a
Identity e
y)) Seq i
up Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
contains (e
x,e
z)) Seq i
up
invLeft :: Bool
invLeft = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
contains (e
x,e
y)) ITree e i
left Bool -> Bool -> Bool
&& forall e i. Interval e i => ITree e i -> Bool
invariant ITree e i
left
invRight :: Bool
invRight = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
contains (e
y,e
z)) ITree e i
right Bool -> Bool -> Bool
&& forall e i. Interval e i => ITree e i -> Bool
invariant ITree e i
right
getIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Seq j
getIntersectsIT :: forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getIntersectsIT i
i (Bin Seq j
bin) = i
i forall e i j. (Interval e i, Interval e j) => j -> Seq i -> Seq i
`intersecting` Seq j
bin
getIntersectsIT i
i (Split Seq j
up e
x e
y e
z ITree e j
left ITree e j
right) = let
m :: Seq j
m = i
i forall e i j. (Interval e i, Interval e j) => j -> Seq i -> Seq i
`intersecting` Seq j
up
l :: Seq j
l = if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` (e
x,e
y) then forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getIntersectsIT i
i ITree e j
left else forall (f :: * -> *) a. Alternative f => f a
empty
r :: Seq j
r = if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` (e
y,e
z) then forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getIntersectsIT i
i ITree e j
right else forall (f :: * -> *) a. Alternative f => f a
empty
in if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`intersects` (e
x,e
z) then Seq j
m forall a. Seq a -> Seq a -> Seq a
>< Seq j
l forall a. Seq a -> Seq a -> Seq a
>< Seq j
r else forall (f :: * -> *) a. Alternative f => f a
empty
getProperIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Seq j
getProperIntersectsIT :: forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getProperIntersectsIT i
i (Bin Seq j
bin) = i
i forall e i j. (Interval e i, Interval e j) => j -> Seq i -> Seq i
`intersectingProperly` Seq j
bin
getProperIntersectsIT i
i (Split Seq j
up e
x e
y e
z ITree e j
left ITree e j
right) = let
m :: Seq j
m = i
i forall e i j. (Interval e i, Interval e j) => j -> Seq i -> Seq i
`intersectingProperly` Seq j
up
l :: Seq j
l = if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`properlyIntersects` (e
x,e
y) then forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getProperIntersectsIT i
i ITree e j
left else forall (f :: * -> *) a. Alternative f => f a
empty
r :: Seq j
r = if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`properlyIntersects` (e
y,e
z) then forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getProperIntersectsIT i
i ITree e j
right else forall (f :: * -> *) a. Alternative f => f a
empty
in if i
i forall e i j. (Interval e i, Interval e j) => i -> j -> Bool
`properlyIntersects` (e
x,e
z) then Seq j
m forall a. Seq a -> Seq a -> Seq a
>< Seq j
l forall a. Seq a -> Seq a -> Seq a
>< Seq j
r else forall (f :: * -> *) a. Alternative f => f a
empty
someIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Bool
someIntersectsIT :: forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Bool
someIntersectsIT i
i = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getIntersectsIT i
i
someProperlyIntersectsIT :: (Interval e i, Interval e j) => i -> ITree e j -> Bool
someProperlyIntersectsIT :: forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Bool
someProperlyIntersectsIT i
i = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e i j.
(Interval e i, Interval e j) =>
i -> ITree e j -> Seq j
getProperIntersectsIT i
i
toTree :: Interval e i => ITree e i -> Tree (e,e)
toTree :: forall e i. Interval e i => ITree e i -> Tree (e, e)
toTree (Bin Seq i
_) = forall a. HasCallStack => String -> a
error String
"Interval.toTree: just a bin"
toTree (Split Seq i
_ e
x e
y e
z ITree e i
left ITree e i
right) = Tree.Node {rootLabel :: (e, e)
Tree.rootLabel = (e
x,e
z), subForest :: [Tree (e, e)]
Tree.subForest = [Tree (e, e)
l,Tree (e, e)
r]} where
l :: Tree (e, e)
l = case ITree e i
left of
(Bin Seq i
_) -> Tree.Node {rootLabel :: (e, e)
Tree.rootLabel = (e
x,e
y), subForest :: [Tree (e, e)]
Tree.subForest = []}
ITree e i
_ -> forall e i. Interval e i => ITree e i -> Tree (e, e)
toTree ITree e i
left
r :: Tree (e, e)
r = case ITree e i
right of
(Bin Seq i
_) -> Tree.Node {rootLabel :: (e, e)
Tree.rootLabel = (e
y,e
z), subForest :: [Tree (e, e)]
Tree.subForest = []}
ITree e i
_ -> forall e i. Interval e i => ITree e i -> Tree (e, e)
toTree ITree e i
right
newtype Block e i = Block (Seq i)
blockstart :: Interval e i => Block e i -> e
blockstart :: forall e i. Interval e i => Block e i -> e
blockstart (Block Seq i
xs) = case forall a. Seq a -> ViewL a
Seq.viewl Seq i
xs of
ViewL i
EmptyL -> forall a. HasCallStack => String -> a
error String
"blockstart: empty Block"
i
x :< Seq i
_ -> forall e i. Interval e i => i -> e
lb i
x
blocknull :: Block e i -> Bool
blocknull :: forall e i. Block e i -> Bool
blocknull (Block Seq i
xs) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq i
xs
instance Interval e i => Eq (Block e i) where
== :: Block e i -> Block e i -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall e i. Interval e i => Block e i -> e
blockstart
instance Interval e i => Ord (Block e i) where
compare :: Block e i -> Block e i -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall e i. Interval e i => Block e i -> e
blockstart)
instance Functor (Block e) where
fmap :: forall a b. (a -> b) -> Block e a -> Block e b
fmap a -> b
f (Block Seq a
xs) = forall e i. Seq i -> Block e i
Block (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs)
instance Foldable (Block e) where
foldMap :: forall m a. Monoid m => (a -> m) -> Block e a -> m
foldMap a -> m
f (Block Seq a
xs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Seq a
xs
instance Semigroup (Block e i) where
(Block Seq i
xs) <> :: Block e i -> Block e i -> Block e i
<> (Block Seq i
ys) = forall e i. Seq i -> Block e i
Block (Seq i
xs forall a. Seq a -> Seq a -> Seq a
>< Seq i
ys)
instance Monoid (Block e i) where
mempty :: Block e i
mempty = forall e i. Seq i -> Block e i
Block forall (f :: * -> *) a. Alternative f => f a
empty
mappend :: Block e i -> Block e i -> Block e i
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Interval e i => Interval e (Block e i) where
lb :: Block e i -> e
lb = forall e i. Interval e i => Block e i -> e
blockstart
ub :: Block e i -> e
ub = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Interval e i => i -> e
ub
instance Show i => Show (Block e i) where
show :: Block e i -> String
show (Block Seq i
xs) = String
"Block "forall a. [a] -> [a] -> [a]
++(forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq i
xs))
filterM :: (Applicative f, Traversable t, Alternative m) => (a -> f Bool) -> t a -> f (m a)
filterM :: forall (f :: * -> *) (t :: * -> *) (m :: * -> *) a.
(Applicative f, Traversable t, Alternative m) =>
(a -> f Bool) -> t a -> f (m a)
filterM a -> f Bool
f = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
b -> if Bool
b then forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a else forall (f :: * -> *) a. Alternative f => f a
empty) (a -> f Bool
f a
a))
crossesAny :: (Interval e i, Foldable f) => i -> f (Block e i) -> Bool
crossesAny :: forall e i (f :: * -> *).
(Interval e i, Foldable f) =>
i -> f (Block e i) -> Bool
crossesAny i
i = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((forall e i. Interval e i => i -> e
ub i
i) forall a. Ord a => a -> a -> Bool
>)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall e i. Interval e i => Block e i -> e
blockstart)
removeCrossers :: Interval e i => Block e i -> Seq (Block e i) -> (Seq i,Block e i)
removeCrossers :: forall e i.
Interval e i =>
Block e i -> Seq (Block e i) -> (Seq i, Block e i)
removeCrossers (Block Seq i
xs) Seq (Block e i)
blocks = let (Seq i
crossers,Seq i
xs') = forall (f :: * -> *) (t :: * -> *) (m :: * -> *) a.
(Applicative f, Traversable t, Alternative m) =>
(a -> f Bool) -> t a -> f (m a)
filterM i -> (Seq i, Bool)
f Seq i
xs in (Seq i
crossers,forall e i. Seq i -> Block e i
Block Seq i
xs') where
f :: i -> (Seq i, Bool)
f i
i = if i
i forall e i (f :: * -> *).
(Interval e i, Foldable f) =>
i -> f (Block e i) -> Bool
`crossesAny` Seq (Block e i)
blocks
then (forall a. a -> Seq a
Seq.singleton i
i,Bool
False)
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
gatherCrossers :: Interval e i => Seq (Block e i) -> (Seq i,Seq (Block e i))
gatherCrossers :: forall e i.
Interval e i =>
Seq (Block e i) -> (Seq i, Seq (Block e i))
gatherCrossers Seq (Block e i)
blks = case forall a. Seq a -> ViewL a
Seq.viewl Seq (Block e i)
blks of
(Block e i
block :< Seq (Block e i)
blocks) -> let
(Seq i
crossers,Seq (Block e i)
blocks') = forall e i.
Interval e i =>
Seq (Block e i) -> (Seq i, Seq (Block e i))
gatherCrossers Seq (Block e i)
blocks
(Seq i
crossers',Block e i
block') = forall e i.
Interval e i =>
Block e i -> Seq (Block e i) -> (Seq i, Block e i)
removeCrossers Block e i
block Seq (Block e i)
blocks'
cons :: Seq (Block e i) -> Seq (Block e i)
cons = if forall e i. Block e i -> Bool
blocknull Block e i
block' then forall a. a -> a
id else (forall a. a -> Seq a -> Seq a
(<|) Block e i
block')
in (Seq i
crossers' forall a. Seq a -> Seq a -> Seq a
>< Seq i
crossers,Seq (Block e i) -> Seq (Block e i)
cons Seq (Block e i)
blocks')
ViewL (Block e i)
EmptyL -> (forall (f :: * -> *) a. Alternative f => f a
empty,forall (f :: * -> *) a. Alternative f => f a
empty)
blocksOf :: Int -> Seq i -> Seq (Block e i)
blocksOf :: forall i e. Int -> Seq i -> Seq (Block e i)
blocksOf Int
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e i. Seq i -> Block e i
Block forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Seq a -> Seq (Seq a)
Seq.chunksOf Int
n
data SplitSeq a = EmptySeq | SingletonSeq a | TwoSeqs (Seq a) (Seq a) deriving (Int -> SplitSeq a -> ShowS
forall a. Show a => Int -> SplitSeq a -> ShowS
forall a. Show a => [SplitSeq a] -> ShowS
forall a. Show a => SplitSeq a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SplitSeq a] -> ShowS
$cshowList :: forall a. Show a => [SplitSeq a] -> ShowS
show :: SplitSeq a -> String
$cshow :: forall a. Show a => SplitSeq a -> String
showsPrec :: Int -> SplitSeq a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SplitSeq a -> ShowS
Show)
joinSeq :: SplitSeq a -> Seq a
joinSeq :: forall a. SplitSeq a -> Seq a
joinSeq SplitSeq a
EmptySeq = forall (f :: * -> *) a. Alternative f => f a
empty
joinSeq (SingletonSeq a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
joinSeq (TwoSeqs Seq a
xs Seq a
ys) = Seq a
xs forall a. Semigroup a => a -> a -> a
<> Seq a
ys
propSplit :: (Seq a -> Bool) -> SplitSeq a -> Bool
propSplit :: forall a. (Seq a -> Bool) -> SplitSeq a -> Bool
propSplit Seq a -> Bool
p (TwoSeqs Seq a
xs Seq a
ys) = Seq a -> Bool
p Seq a
xs Bool -> Bool -> Bool
&& Seq a -> Bool
p Seq a
ys
propSplit Seq a -> Bool
p SplitSeq a
s = Seq a -> Bool
p (forall a. SplitSeq a -> Seq a
joinSeq SplitSeq a
s)
splitSeq :: Seq a -> SplitSeq a
splitSeq :: forall a. Seq a -> SplitSeq a
splitSeq Seq a
xs = let (Seq a
l,Seq a
r) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
xs forall a. Integral a => a -> a -> a
`div` Int
2) Seq a
xs in case (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
l,forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
r) of
(Bool
_,Bool
True) -> forall a. SplitSeq a
EmptySeq
(Bool
True,Bool
False) -> let (a
x :< Seq a
_) = forall a. Seq a -> ViewL a
Seq.viewl Seq a
r in forall a. a -> SplitSeq a
SingletonSeq a
x
(Bool
False,Bool
False) -> forall a. Seq a -> Seq a -> SplitSeq a
TwoSeqs Seq a
l Seq a
r
buildFromSeq :: Interval e i => Seq (Block e i) -> ITree e i
buildFromSeq :: forall e i. Interval e i => Seq (Block e i) -> ITree e i
buildFromSeq Seq (Block e i)
blocks = case forall a. Seq a -> SplitSeq a
splitSeq Seq (Block e i)
blocks of
SplitSeq (Block e i)
EmptySeq -> forall e i. ITree e i
emptyITree
SingletonSeq (Block Seq i
bin) -> forall e i. Seq i -> ITree e i
Bin Seq i
bin
TwoSeqs Seq (Block e i)
lblocks Seq (Block e i)
rblocks -> let
y :: e
y = let Block e i
b :< Seq (Block e i)
_ = forall a. Seq a -> ViewL a
Seq.viewl Seq (Block e i)
rblocks in forall e i. Interval e i => Block e i -> e
blockstart Block e i
b
left :: ITree e i
left = forall e i. Interval e i => Seq (Block e i) -> ITree e i
buildFromSeq Seq (Block e i)
lblocks
right :: ITree e i
right = forall e i. Interval e i => Seq (Block e i) -> ITree e i
buildFromSeq Seq (Block e i)
rblocks
x :: e
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe e
y forall a b. (a, b) -> a
fst (forall e i. Interval e i => ITree e i -> Maybe (e, e)
hullOfTree ITree e i
left)
z :: e
z = forall b a. b -> (a -> b) -> Maybe a -> b
maybe e
y forall a b. (a, b) -> b
snd (forall e i. Interval e i => ITree e i -> Maybe (e, e)
hullOfTree ITree e i
right)
in forall e i.
Seq i -> e -> e -> e -> ITree e i -> ITree e i -> ITree e i
Split forall (f :: * -> *) a. Alternative f => f a
empty e
x e
y e
z ITree e i
left ITree e i
right
insert :: Interval e i => i -> ITree e i -> ITree e i
insert :: forall e i. Interval e i => i -> ITree e i -> ITree e i
insert i
i (Bin Seq i
xs) = forall e i. Seq i -> ITree e i
Bin (i
i forall a. a -> Seq a -> Seq a
<| Seq i
xs)
insert i
i (Split Seq i
up e
x e
y e
z ITree e i
left ITree e i
right) = if forall e i. Interval e i => i -> e
ub i
i forall a. Ord a => a -> a -> Bool
<= e
y
then let
left' :: ITree e i
left' = (forall e i. Interval e i => i -> ITree e i -> ITree e i
insert i
i ITree e i
left)
x' :: e
x' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe e
x (forall a. Ord a => a -> a -> a
min e
xforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (forall e i. Interval e i => ITree e i -> Maybe (e, e)
hullOfTree ITree e i
left')
in forall e i.
Seq i -> e -> e -> e -> ITree e i -> ITree e i -> ITree e i
Split Seq i
up e
x' e
y e
z ITree e i
left' ITree e i
right
else if forall e i. Interval e i => i -> e
lb i
i forall a. Ord a => a -> a -> Bool
< e
y
then forall e i.
Seq i -> e -> e -> e -> ITree e i -> ITree e i -> ITree e i
Split (i
i forall a. a -> Seq a -> Seq a
<| Seq i
up) (forall a. Ord a => a -> a -> a
min e
x (forall e i. Interval e i => i -> e
lb i
i)) e
y (forall a. Ord a => a -> a -> a
max e
z (forall e i. Interval e i => i -> e
ub i
i)) ITree e i
left ITree e i
right
else let
right' :: ITree e i
right' = forall e i. Interval e i => i -> ITree e i -> ITree e i
insert i
i ITree e i
right
z' :: e
z' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe e
z (forall a. Ord a => a -> a -> a
max e
zforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (forall e i. Interval e i => ITree e i -> Maybe (e, e)
hullOfTree ITree e i
right')
in forall e i.
Seq i -> e -> e -> e -> ITree e i -> ITree e i -> ITree e i
Split Seq i
up e
x e
y e
z' ITree e i
left ITree e i
right'
itree :: Interval e i => Int -> Seq i -> ITree e i
itree :: forall e i. Interval e i => Int -> Seq i -> ITree e i
itree Int
n = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
($)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Seq i -> ITree e i -> ITree e i
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall e i. Interval e i => Seq (Block e i) -> ITree e i
buildFromSeq)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall e i.
Interval e i =>
Seq (Block e i) -> (Seq i, Seq (Block e i))
gatherCrossersforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall i e. Int -> Seq i -> Seq (Block e i)
blocksOf Int
nforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall e i. Interval e i => Seq i -> Seq i
blocksort where
f :: Seq i -> ITree e i -> ITree e i
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' forall e i. Interval e i => i -> ITree e i -> ITree e i
insert)
blocksort :: Interval e i => Seq i -> Seq i
blocksort :: forall e i. Interval e i => Seq i -> Seq i
blocksort = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.unstableSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall e i. Interval e i => i -> e
lb)
hullSeqNonNested :: Interval e i => Seq i -> Maybe (e,e)
hullSeqNonNested :: forall e i. Interval e i => Seq i -> Maybe (e, e)
hullSeqNonNested Seq i
xs = case forall a. Seq a -> ViewL a
Seq.viewl Seq i
xs of
ViewL i
EmptyL -> forall a. Maybe a
Nothing
i
leftmost :< Seq i
others -> forall a. a -> Maybe a
Just (forall e i. Interval e i => i -> e
lb i
leftmost, case forall a. Seq a -> ViewR a
Seq.viewr Seq i
others of
Seq i
_ :> i
rightmost -> forall e i. Interval e i => i -> e
ub i
rightmost
ViewR i
EmptyR -> forall e i. Interval e i => i -> e
ub i
leftmost)
findSeq :: (Interval e i, Interval e j) => (i -> (e,e) -> Bool) -> i -> Seq j -> Seq j
findSeq :: forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Seq j
findSeq i -> (e, e) -> Bool
p i
i Seq j
js = case forall e i. Interval e i => Seq i -> Maybe (e, e)
hullSeqNonNested Seq j
js of
Maybe (e, e)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty
Just (e, e)
h -> if i -> (e, e) -> Bool
p i
i (e, e)
h
then case forall a. Seq a -> SplitSeq a
splitSeq Seq j
js of
SingletonSeq j
_j -> Seq j
js
TwoSeqs Seq j
l Seq j
r -> forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Seq j
findSeq i -> (e, e) -> Bool
p i
i Seq j
l forall a. Seq a -> Seq a -> Seq a
>< forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Seq j
findSeq i -> (e, e) -> Bool
p i
i Seq j
r
SplitSeq j
EmptySeq -> forall (f :: * -> *) a. Alternative f => f a
empty
else forall (f :: * -> *) a. Alternative f => f a
empty
existsSeq :: (Interval e i, Interval e j) => (i -> (e,e) -> Bool) -> i -> Seq j -> Bool
existsSeq :: forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Bool
existsSeq i -> (e, e) -> Bool
p i
i Seq j
js = case forall e i. Interval e i => Seq i -> Maybe (e, e)
hullSeqNonNested Seq j
js of
Maybe (e, e)
Nothing -> Bool
False
Just (e, e)
h -> if i -> (e, e) -> Bool
p i
i (e, e)
h
then case forall a. Seq a -> SplitSeq a
splitSeq Seq j
js of
SingletonSeq j
_j -> Bool
True
TwoSeqs Seq j
l Seq j
r -> forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Bool
existsSeq i -> (e, e) -> Bool
p i
i Seq j
l Bool -> Bool -> Bool
|| forall e i j.
(Interval e i, Interval e j) =>
(i -> (e, e) -> Bool) -> i -> Seq j -> Bool
existsSeq i -> (e, e) -> Bool
p i
i Seq j
r
SplitSeq j
EmptySeq -> Bool
False
else Bool
False