{-# LANGUAGE Safe #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
module IntervalAlgebra.IntervalUtilities
(
combineIntervals
, combineIntervalsL
, combineIntervalsFromSorted
, combineIntervalsFromSortedL
, rangeInterval
, gaps
, gapsL
, gapsWithin
, foldMeetingSafe
, formMeetingSequence
, nothingIf
, nothingIfNone
, nothingIfAny
, nothingIfAll
, filterBefore
, filterMeets
, filterOverlaps
, filterFinishedBy
, filterContains
, filterStarts
, filterEquals
, filterStartedBy
, filterDuring
, filterFinishes
, filterOverlappedBy
, filterMetBy
, filterAfter
, filterDisjoint
, filterNotDisjoint
, filterConcur
, filterWithin
, filterEncloses
, filterEnclosedBy
, lookback
, lookahead
, makeGapsWithinPredicate
, pairGaps
, anyGapsWithinAtLeastDuration
, allGapsWithinLessThanDuration
, relations
, relationsL
, intersect
, clip
, durations
) where
import safe Control.Applicative ( (<$>)
, (<*>)
, Applicative(pure)
, liftA2
)
import qualified Control.Foldl as L
import safe Control.Monad ( Functor(fmap) )
import safe Data.Bool ( (&&)
, Bool(..)
, not
, otherwise
, (||)
)
import safe Data.Eq ( Eq((==)) )
import safe Data.Foldable ( Foldable
( foldl'
, foldr
, null
, toList
)
, all
, any
, or
)
import safe Data.Function ( ($)
, (.)
, flip
)
import safe Data.List ( map
, reverse
, sortOn
)
import safe Data.Maybe ( Maybe(..)
, maybe
, maybeToList
)
import safe Data.Monoid ( Monoid(mempty) )
import safe Data.Ord ( (<)
, (>=)
, Ord(max, min)
)
import safe Data.Semigroup ( Semigroup((<>)) )
import safe Data.Traversable ( Traversable(sequenceA) )
import safe Data.Tuple ( fst
, uncurry
)
import safe GHC.Int ( Int )
import safe GHC.Show ( Show )
import safe IntervalAlgebra.Core ( (<|>)
, ComparativePredicateOf1
, ComparativePredicateOf2
, Interval
, IntervalCombinable((><))
, IntervalRelation(..)
, IntervalSizeable
( diff
, duration
)
, Intervallic(..)
, after
, before
, begin
, beginerval
, beginervalFromEnd
, bi
, concur
, contains
, disjoint
, during
, enclosedBy
, encloses
, end
, enderval
, endervalFromBegin
, equals
, extenterval
, finishedBy
, finishes
, meets
, metBy
, notDisjoint
, overlappedBy
, overlaps
, relate
, startedBy
, starts
, within
)
import safe IntervalAlgebra.PairedInterval ( PairedInterval
, equalPairData
, getPairData
, makePairedInterval
)
import safe Safe ( headMay
, initSafe
, lastMay
, tailSafe
)
import safe Witherable ( Filterable(filter)
, Witherable(..)
, catMaybes
, mapMaybe
)
makeFolder :: (Monoid (m b), Applicative m) => (a -> a -> b) -> L.Fold a (m b)
makeFolder :: (a -> a -> b) -> Fold a (m b)
makeFolder a -> a -> b
f = ((m b, Maybe a) -> a -> (m b, Maybe a))
-> (m b, Maybe a) -> ((m b, Maybe a) -> m b) -> Fold a (m b)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (m b, Maybe a) -> a -> (m b, Maybe a)
forall (f :: * -> *).
(Semigroup (f b), Applicative f) =>
(f b, Maybe a) -> a -> (f b, Maybe a)
step (m b, Maybe a)
forall a. (m b, Maybe a)
begin (m b, Maybe a) -> m b
forall a b. (a, b) -> a
done
where
begin :: (m b, Maybe a)
begin = (m b
forall a. Monoid a => a
mempty, Maybe a
forall a. Maybe a
Nothing)
step :: (f b, Maybe a) -> a -> (f b, Maybe a)
step (f b
fs, Maybe a
Nothing) a
y = (f b
fs, a -> Maybe a
forall a. a -> Maybe a
Just a
y)
step (f b
fs, Just a
x ) a
y = (f b
fs f b -> f b -> f b
forall a. Semigroup a => a -> a -> a
<> b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> b
f a
x a
y), a -> Maybe a
forall a. a -> Maybe a
Just a
y)
done :: (a, b) -> a
done (a
fs, b
_) = a
fs
makeGapsWithinPredicate
:: ( Monoid (t (Interval a))
, Monoid (t (Maybe (Interval a)))
, Applicative t
, Witherable.Witherable t
, IntervalSizeable a b
, Intervallic i0
, IntervalCombinable i1 a
)
=> ((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool)
-> (b -> i0 a -> t (i1 a) -> Bool)
makeGapsWithinPredicate :: ((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
makeGapsWithinPredicate (b -> Bool) -> t b -> Bool
f b -> b -> Bool
op b
gapDuration i0 a
interval t (i1 a)
l =
Bool -> (t (Interval a) -> Bool) -> Maybe (t (Interval a)) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((b -> Bool) -> t b -> Bool
f (b -> b -> Bool
`op` b
gapDuration) (t b -> Bool) -> (t (Interval a) -> t b) -> t (Interval a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Interval a) -> t b
forall (f :: * -> *) (i :: * -> *) a b.
(Functor f, Intervallic i, IntervalSizeable a b) =>
f (i a) -> f b
durations) (i0 a -> t (i1 a) -> Maybe (t (Interval a))
forall (f :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Applicative f, Witherable f, Monoid (f (Interval a)),
Monoid (f (Maybe (Interval a))), IntervalSizeable a b,
Intervallic i0, IntervalCombinable i1 a) =>
i0 a -> f (i1 a) -> Maybe (f (Interval a))
gapsWithin i0 a
interval t (i1 a)
l)
pairGaps
:: (Intervallic i, IntervalSizeable a b, IntervalCombinable i a)
=> [i a]
-> [Maybe b]
pairGaps :: [i a] -> [Maybe b]
pairGaps [i a]
es = ((i a, i a) -> Maybe b) -> [(i a, i a)] -> [Maybe b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((i a -> b) -> Maybe (i a) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
i a -> b
duration (Maybe (i a) -> Maybe b)
-> ((i a, i a) -> Maybe (i a)) -> (i a, i a) -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> i a -> Maybe (i a)) -> (i a, i a) -> Maybe (i a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry i a -> i a -> Maybe (i a)
forall (i :: * -> *) a.
IntervalCombinable i a =>
i a -> i a -> Maybe (i a)
(><)) ([i a] -> [(i a, i a)]
forall t. [t] -> [(t, t)]
pairs [i a]
es)
where
pairs :: [t] -> [(t, t)]
pairs = [t] -> [(t, t)]
forall t. [t] -> [(t, t)]
go
where
go :: [t] -> [(t, t)]
go [] = []
go (t
x : [t]
xs) = (t -> (t, t)) -> [t] -> [(t, t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
x, ) [t]
xs [(t, t)] -> [(t, t)] -> [(t, t)]
forall a. Semigroup a => a -> a -> a
<> [t] -> [(t, t)]
go [t]
xs
lookback
:: (Intervallic i, IntervalSizeable a b)
=> b
-> i a
-> Interval a
lookback :: b -> i a -> Interval a
lookback b
d i a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
d (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
x)
lookahead
:: (Intervallic i, IntervalSizeable a b)
=> b
-> i a
-> Interval a
lookahead :: b -> i a -> Interval a
lookahead b
d i a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
d (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
x)
anyGapsWithinAtLeastDuration
:: ( IntervalSizeable a b
, Intervallic i0
, IntervalCombinable i1 a
, Monoid (t (Interval a))
, Monoid (t (Maybe (Interval a)))
, Applicative t
, Witherable.Witherable t
)
=> b
-> i0 a
-> t (i1 a)
-> Bool
anyGapsWithinAtLeastDuration :: b -> i0 a -> t (i1 a) -> Bool
anyGapsWithinAtLeastDuration = ((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
forall (t :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
Applicative t, Witherable t, IntervalSizeable a b, Intervallic i0,
IntervalCombinable i1 a) =>
((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
makeGapsWithinPredicate (b -> Bool) -> t b -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
allGapsWithinLessThanDuration
:: ( IntervalSizeable a b
, Intervallic i0
, IntervalCombinable i1 a
, Monoid (t (Interval a))
, Monoid (t (Maybe (Interval a)))
, Applicative t
, Witherable.Witherable t
)
=> b
-> i0 a
-> t (i1 a)
-> Bool
allGapsWithinLessThanDuration :: b -> i0 a -> t (i1 a) -> Bool
allGapsWithinLessThanDuration = ((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
forall (t :: * -> *) a b (i0 :: * -> *) (i1 :: * -> *).
(Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))),
Applicative t, Witherable t, IntervalSizeable a b, Intervallic i0,
IntervalCombinable i1 a) =>
((b -> Bool) -> t b -> Bool)
-> (b -> b -> Bool) -> b -> i0 a -> t (i1 a) -> Bool
makeGapsWithinPredicate (b -> Bool) -> t b -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all b -> b -> Bool
forall a. Ord a => a -> a -> Bool
(<)
listCombiner
:: (Maybe a -> Maybe a -> [a])
-> [a]
-> [a]
-> [a]
listCombiner :: (Maybe a -> Maybe a -> [a]) -> [a] -> [a] -> [a]
listCombiner Maybe a -> Maybe a -> [a]
f [a]
x [a]
y = [a] -> [a]
forall a. [a] -> [a]
initSafe [a]
x [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> Maybe a -> Maybe a -> [a]
f ([a] -> Maybe a
forall a. [a] -> Maybe a
lastMay [a]
x) ([a] -> Maybe a
forall a. [a] -> Maybe a
headMay [a]
y) [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a] -> [a]
forall a. [a] -> [a]
tailSafe [a]
y
{-# INLINABLE listCombiner #-}
relationsL
:: (Foldable f, Ord a, Intervallic i) => f (i a) -> [IntervalRelation]
relationsL :: f (i a) -> [IntervalRelation]
relationsL = f (i a) -> [IntervalRelation]
forall (f :: * -> *) (m :: * -> *) a (i :: * -> *).
(Foldable f, Applicative m, Ord a, Intervallic i,
Monoid (m IntervalRelation)) =>
f (i a) -> m IntervalRelation
relations
relations
:: ( Foldable f
, Applicative m
, Ord a
, Intervallic i
, Monoid (m IntervalRelation)
)
=> f (i a)
-> m IntervalRelation
relations :: f (i a) -> m IntervalRelation
relations = Fold (i a) (m IntervalRelation) -> f (i a) -> m IntervalRelation
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((i a -> i a -> IntervalRelation) -> Fold (i a) (m IntervalRelation)
forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder i a -> i a -> IntervalRelation
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> i1 a -> IntervalRelation
relate)
{-# INLINABLE relations #-}
intersect
:: (Intervallic i, IntervalSizeable a b) => i a -> i a -> Maybe (Interval a)
intersect :: i a -> i a -> Maybe (Interval a)
intersect i a
x i a
y | ComparativePredicateOf2 (i a) (i a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint i a
x i a
y = Maybe (Interval a)
forall a. Maybe a
Nothing
| Bool
otherwise = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff a
e a
b) a
b
where
b :: a
b = a -> a -> a
forall a. Ord a => a -> a -> a
max (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
y)
e :: a
e = a -> a -> a
forall a. Ord a => a -> a -> a
min (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
y)
gapsM
:: ( IntervalCombinable i a
, Traversable f
, Monoid (f (Maybe (Interval a)))
, Applicative f
)
=> f (i a)
-> f (Maybe (Interval a))
gapsM :: f (i a) -> f (Maybe (Interval a))
gapsM = Fold (i a) (f (Maybe (Interval a)))
-> f (i a) -> f (Maybe (Interval a))
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((i a -> i a -> Maybe (Interval a))
-> Fold (i a) (f (Maybe (Interval a)))
forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder (\i a
i i a
j -> i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
i Interval a -> Interval a -> Maybe (Interval a)
forall (i :: * -> *) a.
IntervalCombinable i a =>
i a -> i a -> Maybe (i a)
>< i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
j))
{-# INLINABLE gapsM #-}
gaps
:: ( IntervalCombinable i a
, Traversable f
, Monoid (f (Maybe (Interval a)))
, Applicative f
)
=> f (i a)
-> Maybe (f (Interval a))
gaps :: f (i a) -> Maybe (f (Interval a))
gaps = f (Maybe (Interval a)) -> Maybe (f (Interval a))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (f (Maybe (Interval a)) -> Maybe (f (Interval a)))
-> (f (i a) -> f (Maybe (Interval a)))
-> f (i a)
-> Maybe (f (Interval a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (i a) -> f (Maybe (Interval a))
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> f (Maybe (Interval a))
gapsM
{-# INLINABLE gaps #-}
gapsL
:: ( IntervalCombinable i a
, Applicative f
, Monoid (f (Maybe (Interval a)))
, Traversable f
)
=> f (i a)
-> [Interval a]
gapsL :: f (i a) -> [Interval a]
gapsL f (i a)
x = [Interval a]
-> (f (Interval a) -> [Interval a])
-> Maybe (f (Interval a))
-> [Interval a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] f (Interval a) -> [Interval a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f (i a) -> Maybe (f (Interval a))
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> Maybe (f (Interval a))
gaps f (i a)
x)
{-# INLINABLE gapsL #-}
durations :: (Functor f, Intervallic i, IntervalSizeable a b) => f (i a) -> f b
durations :: f (i a) -> f b
durations = (i a -> b) -> f (i a) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap i a -> b
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
i a -> b
duration
clip
:: (Intervallic i0, Intervallic i1, IntervalSizeable a b)
=> i0 a
-> i1 a
-> Maybe (Interval a)
clip :: i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
x i1 a
y
| ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i0 a
x i1 a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x) (i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y)) (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x)
| ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy i0 a
x i1 a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y) (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x)) (i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x)
| ComparativePredicateOf2 (i0 a) (i1 a)
jx i0 a
x i1 a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x)
| ComparativePredicateOf2 (i0 a) (i1 a)
jy i0 a
x i1 a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y)
| Bool
otherwise = Maybe (Interval a)
forall a. Maybe a
Nothing
where
jy :: ComparativePredicateOf2 (i0 a) (i1 a)
jy = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
jx :: ComparativePredicateOf2 (i0 a) (i1 a)
jx = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
{-# INLINABLE clip #-}
gapsWithin
:: ( Applicative f
, Witherable f
, Monoid (f (Interval a))
, Monoid (f (Maybe (Interval a)))
, IntervalSizeable a b
, Intervallic i0
, IntervalCombinable i1 a
)
=> i0 a
-> f (i1 a)
-> Maybe (f (Interval a))
gapsWithin :: i0 a -> f (i1 a) -> Maybe (f (Interval a))
gapsWithin i0 a
i f (i1 a)
x | f (Interval a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f (Interval a)
ivs = Maybe (f (Interval a))
forall a. Maybe a
Nothing
| Bool
otherwise = f (Interval a) -> Maybe (f (Interval a))
forall a. a -> Maybe a
Just f (Interval a)
res
where
s :: f (Interval a)
s = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> i0 a -> Interval a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> Interval a
endervalFromBegin b
0 i0 a
i)
e :: f (Interval a)
e = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> i0 a -> Interval a
forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> Interval a
beginervalFromEnd b
0 i0 a
i)
ivs :: f (Interval a)
ivs = (i1 a -> Maybe (Interval a)) -> f (i1 a) -> f (Interval a)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (i0 a -> i1 a -> Maybe (Interval a)
forall (i0 :: * -> *) (i1 :: * -> *) a b.
(Intervallic i0, Intervallic i1, IntervalSizeable a b) =>
i0 a -> i1 a -> Maybe (Interval a)
clip i0 a
i) (i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a (i0 :: * -> *) (i1 :: * -> *).
(Filterable f, Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint i0 a
i f (i1 a)
x)
res :: f (Interval a)
res = f (Maybe (Interval a)) -> f (Interval a)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (f (Maybe (Interval a)) -> f (Interval a))
-> f (Maybe (Interval a)) -> f (Interval a)
forall a b. (a -> b) -> a -> b
$ f (Interval a) -> f (Maybe (Interval a))
forall (i :: * -> *) a (f :: * -> *).
(IntervalCombinable i a, Traversable f,
Monoid (f (Maybe (Interval a))), Applicative f) =>
f (i a) -> f (Maybe (Interval a))
gapsM (f (Interval a)
s f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> f (Interval a)
ivs f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> f (Interval a)
e)
{-# INLINABLE gapsWithin #-}
combineIntervals
:: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)
=> f (i a)
-> f (Interval a)
combineIntervals :: f (i a) -> f (Interval a)
combineIntervals = ([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
Foldable f) =>
([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
combineIntervalsWith [i a] -> [Interval a]
forall (i :: * -> *) a.
(Intervallic i, Ord a) =>
[i a] -> [Interval a]
combineIntervalsL
combineIntervalsFromSorted
:: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)
=> f (i a)
-> f (Interval a)
combineIntervalsFromSorted :: f (i a) -> f (Interval a)
combineIntervalsFromSorted = ([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
forall (f :: * -> *) a (i :: * -> *).
(Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)),
Foldable f) =>
([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
combineIntervalsWith [i a] -> [Interval a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> [Interval a]
combineIntervalsFromSortedL
combineIntervalsWith
:: (Applicative f, Ord a, Intervallic i, Monoid (f (Interval a)), Foldable f)
=> ([i a] -> [Interval a])
-> f (i a)
-> f (Interval a)
combineIntervalsWith :: ([i a] -> [Interval a]) -> f (i a) -> f (Interval a)
combineIntervalsWith [i a] -> [Interval a]
f f (i a)
x = (f (Interval a) -> Interval a -> f (Interval a))
-> f (Interval a) -> [Interval a] -> f (Interval a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\f (Interval a)
x Interval a
y -> f (Interval a)
x f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interval a
y) f (Interval a)
forall a. Monoid a => a
mempty ([i a] -> [Interval a]
f ([i a] -> [Interval a]) -> [i a] -> [Interval a]
forall a b. (a -> b) -> a -> b
$ f (i a) -> [i a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (i a)
x)
combineIntervalsL :: (Intervallic i, Ord a) => [i a] -> [Interval a]
combineIntervalsL :: [i a] -> [Interval a]
combineIntervalsL = [i a] -> [Interval a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> [Interval a]
combineIntervalsFromSortedL ([i a] -> [Interval a])
-> ([i a] -> [i a]) -> [i a] -> [Interval a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> Interval a) -> [i a] -> [i a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval
combineIntervalsFromSortedL
:: forall a i . (Ord a, Intervallic i) => [i a] -> [Interval a]
combineIntervalsFromSortedL :: [i a] -> [Interval a]
combineIntervalsFromSortedL = [Interval a] -> [Interval a]
forall a. [a] -> [a]
reverse ([Interval a] -> [Interval a])
-> ([i a] -> [Interval a]) -> [i a] -> [Interval a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Interval a] -> i a -> [Interval a])
-> [Interval a] -> [i a] -> [Interval a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Interval a] -> i a -> [Interval a]
forall (i1 :: * -> *) a.
(Ord a, Intervallic i1) =>
[Interval a] -> i1 a -> [Interval a]
op []
where
op :: [Interval a] -> i1 a -> [Interval a]
op [] i1 a
y = [i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y]
op (Interval a
x : [Interval a]
xs) i1 a
y = if Interval a
x ComparativePredicateOf2 (Interval a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` i1 a
y
then Interval a
yiv Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: Interval a
x Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: [Interval a]
xs
else Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval Interval a
x Interval a
yiv Interval a -> [Interval a] -> [Interval a]
forall a. a -> [a] -> [a]
: [Interval a]
xs
where yiv :: Interval a
yiv = i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y
rangeInterval :: (Ord a, L.Foldable t) => t (Interval a) -> Maybe (Interval a)
rangeInterval :: t (Interval a) -> Maybe (Interval a)
rangeInterval = Fold (Interval a) (Maybe (Interval a))
-> t (Interval a) -> Maybe (Interval a)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((Interval a -> Interval a -> Interval a)
-> Maybe (Interval a) -> Maybe (Interval a) -> Maybe (Interval a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval (Maybe (Interval a) -> Maybe (Interval a) -> Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a) -> Maybe (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold (Interval a) (Maybe (Interval a))
forall a. Ord a => Fold a (Maybe a)
L.minimum Fold (Interval a) (Maybe (Interval a) -> Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
-> Fold (Interval a) (Maybe (Interval a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold (Interval a) (Maybe (Interval a))
forall a. Ord a => Fold a (Maybe a)
L.maximum)
nothingIf
:: (Monoid (f (i a)), Filterable f)
=> ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool)
-> f (i a)
-> Maybe (f (i a))
nothingIf :: ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (i a -> Bool) -> f (i a) -> Bool
quantifier i a -> Bool
predicate f (i a)
x =
if (i a -> Bool) -> f (i a) -> Bool
quantifier i a -> Bool
predicate f (i a)
x then Maybe (f (i a))
forall a. Maybe a
Nothing else f (i a) -> Maybe (f (i a))
forall a. a -> Maybe a
Just f (i a)
x
nothingIfNone
:: (Monoid (f (i a)), Foldable f, Filterable f)
=> (i a -> Bool)
-> f (i a)
-> Maybe (f (i a))
nothingIfNone :: (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIfNone = ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f) =>
((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (\i a -> Bool
f f (i a)
x -> (Bool -> Bool
not (Bool -> Bool) -> (f (i a) -> Bool) -> f (i a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i a -> Bool) -> f (i a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any i a -> Bool
f) f (i a)
x)
nothingIfAny
:: (Monoid (f (i a)), Foldable f, Filterable f)
=> (i a -> Bool)
-> f (i a)
-> Maybe (f (i a))
nothingIfAny :: (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIfAny = ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f) =>
((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (i a -> Bool) -> f (i a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
nothingIfAll
:: (Monoid (f (i a)), Foldable f, Filterable f)
=> (i a -> Bool)
-> f (i a)
-> Maybe (f (i a))
nothingIfAll :: (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIfAll = ((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
forall (f :: * -> *) (i :: * -> *) a.
(Monoid (f (i a)), Filterable f) =>
((i a -> Bool) -> f (i a) -> Bool)
-> (i a -> Bool) -> f (i a) -> Maybe (f (i a))
nothingIf (i a -> Bool) -> f (i a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
makeFilter
:: (Filterable f, Intervallic i0, Intervallic i1)
=> ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a
-> (f (i1 a) -> f (i1 a))
makeFilter :: ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
f i0 a
p = (i1 a -> Bool) -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
Witherable.filter (ComparativePredicateOf2 (i0 a) (i1 a)
f i0 a
p)
filterOverlaps, filterOverlappedBy, filterBefore, filterAfter, filterStarts, filterStartedBy, filterFinishes, filterFinishedBy, filterMeets, filterMetBy, filterDuring, filterContains, filterEquals, filterDisjoint, filterNotDisjoint, filterConcur, filterWithin, filterEncloses, filterEnclosedBy
:: (Filterable f, Ord a, Intervallic i0, Intervallic i1)
=> i0 a
-> f (i1 a)
-> f (i1 a)
filterOverlaps :: i0 a -> f (i1 a) -> f (i1 a)
filterOverlaps = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps
filterOverlappedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterOverlappedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy
filterBefore :: i0 a -> f (i1 a) -> f (i1 a)
filterBefore = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
filterAfter :: i0 a -> f (i1 a) -> f (i1 a)
filterAfter = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after
filterStarts :: i0 a -> f (i1 a) -> f (i1 a)
filterStarts = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
filterStartedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterStartedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy
filterFinishes :: i0 a -> f (i1 a) -> f (i1 a)
filterFinishes = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
filterFinishedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterFinishedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
filterMeets :: i0 a -> f (i1 a) -> f (i1 a)
filterMeets = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets
filterMetBy :: i0 a -> f (i1 a) -> f (i1 a)
filterMetBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy
filterDuring :: i0 a -> f (i1 a) -> f (i1 a)
filterDuring = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during
filterContains :: i0 a -> f (i1 a) -> f (i1 a)
filterContains = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains
filterEquals :: i0 a -> f (i1 a) -> f (i1 a)
filterEquals = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals
filterDisjoint :: i0 a -> f (i1 a) -> f (i1 a)
filterDisjoint = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint
filterNotDisjoint :: i0 a -> f (i1 a) -> f (i1 a)
filterNotDisjoint = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint
filterConcur :: i0 a -> f (i1 a) -> f (i1 a)
filterConcur = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur
filterWithin :: i0 a -> f (i1 a) -> f (i1 a)
filterWithin = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
within
filterEncloses :: i0 a -> f (i1 a) -> f (i1 a)
filterEncloses = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
encloses
filterEnclosedBy :: i0 a -> f (i1 a) -> f (i1 a)
filterEnclosedBy = ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
forall (f :: * -> *) (i0 :: * -> *) (i1 :: * -> *) a.
(Filterable f, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> i0 a -> f (i1 a) -> f (i1 a)
makeFilter ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
enclosedBy
foldMeetingSafe
:: (Eq b, Ord a, Show a)
=> [PairedInterval b a]
-> [PairedInterval b a]
foldMeetingSafe :: [PairedInterval b a] -> [PairedInterval b a]
foldMeetingSafe [PairedInterval b a]
l = [PairedInterval b a]
-> (Meeting [PairedInterval b a] -> [PairedInterval b a])
-> Maybe (Meeting [PairedInterval b a])
-> [PairedInterval b a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Meeting [PairedInterval b a] -> [PairedInterval b a]
forall a. Meeting a -> a
getMeeting (Meeting [PairedInterval b a] -> [PairedInterval b a])
-> (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a]
-> [PairedInterval b a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting) ([PairedInterval b a] -> Maybe (Meeting [PairedInterval b a])
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
[i a] -> Maybe (Meeting [i a])
parseMeeting [PairedInterval b a]
l)
foldMeeting
:: (Eq b, Ord a, Show a)
=> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
foldMeeting :: Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a]
l) =
(Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a]
-> [Meeting [PairedInterval b a]]
-> Meeting [PairedInterval b a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
joinMeetingPairedInterval ([PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting []) ([PairedInterval b a] -> [Meeting [PairedInterval b a]]
forall a. [a] -> [Meeting [a]]
packMeeting [PairedInterval b a]
l)
newtype Meeting a = Meeting { Meeting a -> a
getMeeting :: a } deriving (Meeting a -> Meeting a -> Bool
(Meeting a -> Meeting a -> Bool)
-> (Meeting a -> Meeting a -> Bool) -> Eq (Meeting a)
forall a. Eq a => Meeting a -> Meeting a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meeting a -> Meeting a -> Bool
$c/= :: forall a. Eq a => Meeting a -> Meeting a -> Bool
== :: Meeting a -> Meeting a -> Bool
$c== :: forall a. Eq a => Meeting a -> Meeting a -> Bool
Eq, Int -> Meeting a -> ShowS
[Meeting a] -> ShowS
Meeting a -> String
(Int -> Meeting a -> ShowS)
-> (Meeting a -> String)
-> ([Meeting a] -> ShowS)
-> Show (Meeting a)
forall a. Show a => Int -> Meeting a -> ShowS
forall a. Show a => [Meeting a] -> ShowS
forall a. Show a => Meeting a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meeting a] -> ShowS
$cshowList :: forall a. Show a => [Meeting a] -> ShowS
show :: Meeting a -> String
$cshow :: forall a. Show a => Meeting a -> String
showsPrec :: Int -> Meeting a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Meeting a -> ShowS
Show)
packMeeting :: [a] -> [Meeting [a]]
packMeeting :: [a] -> [Meeting [a]]
packMeeting = (a -> Meeting [a]) -> [a] -> [Meeting [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
z -> [a] -> Meeting [a]
forall a. a -> Meeting a
Meeting [a
z])
parseMeeting :: (Ord a, Intervallic i) => [i a] -> Maybe (Meeting [i a])
parseMeeting :: [i a] -> Maybe (Meeting [i a])
parseMeeting [i a]
x | (IntervalRelation -> Bool) -> [IntervalRelation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Meets) ([i a] -> [IntervalRelation]
forall (f :: * -> *) a (i :: * -> *).
(Foldable f, Ord a, Intervallic i) =>
f (i a) -> [IntervalRelation]
relationsL [i a]
x) = Meeting [i a] -> Maybe (Meeting [i a])
forall a. a -> Maybe a
Just (Meeting [i a] -> Maybe (Meeting [i a]))
-> Meeting [i a] -> Maybe (Meeting [i a])
forall a b. (a -> b) -> a -> b
$ [i a] -> Meeting [i a]
forall a. a -> Meeting a
Meeting [i a]
x
| Bool
otherwise = Maybe (Meeting [i a])
forall a. Maybe a
Nothing
joinMeetingPairedInterval
:: (Eq b, Ord a, Show a)
=> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
joinMeetingPairedInterval :: Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
joinMeetingPairedInterval = ComparativePredicateOf1 (PairedInterval b a)
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
-> Meeting [PairedInterval b a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
ComparativePredicateOf1 (i a)
-> Meeting [i a] -> Meeting [i a] -> Meeting [i a]
joinMeeting ComparativePredicateOf1 (PairedInterval b a)
forall b a. Eq b => ComparativePredicateOf1 (PairedInterval b a)
equalPairData
joinMeeting
:: (Ord a, Intervallic i)
=> ComparativePredicateOf1 (i a)
-> Meeting [i a]
-> Meeting [i a]
-> Meeting [i a]
joinMeeting :: ComparativePredicateOf1 (i a)
-> Meeting [i a] -> Meeting [i a] -> Meeting [i a]
joinMeeting ComparativePredicateOf1 (i a)
f (Meeting [i a]
x) (Meeting [i a]
y) =
[i a] -> Meeting [i a]
forall a. a -> Meeting a
Meeting ([i a] -> Meeting [i a]) -> [i a] -> Meeting [i a]
forall a b. (a -> b) -> a -> b
$ (Maybe (i a) -> Maybe (i a) -> [i a]) -> [i a] -> [i a] -> [i a]
forall a. (Maybe a -> Maybe a -> [a]) -> [a] -> [a] -> [a]
listCombiner (ComparativePredicateOf1 (i a)
-> Maybe (i a) -> Maybe (i a) -> [i a]
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
ComparativePredicateOf1 (i a)
-> Maybe (i a) -> Maybe (i a) -> [i a]
join2MeetingWhen ComparativePredicateOf1 (i a)
f) [i a]
x [i a]
y
join2MeetingWhen
:: (Ord a, Intervallic i)
=> ComparativePredicateOf1 (i a)
-> Maybe (i a)
-> Maybe (i a)
-> [i a]
join2MeetingWhen :: ComparativePredicateOf1 (i a)
-> Maybe (i a) -> Maybe (i a) -> [i a]
join2MeetingWhen ComparativePredicateOf1 (i a)
p Maybe (i a)
Nothing Maybe (i a)
Nothing = []
join2MeetingWhen ComparativePredicateOf1 (i a)
p Maybe (i a)
Nothing (Just i a
y) = [i a
y]
join2MeetingWhen ComparativePredicateOf1 (i a)
p (Just i a
x) Maybe (i a)
Nothing = [i a
x]
join2MeetingWhen ComparativePredicateOf1 (i a)
p (Just i a
x) (Just i a
y) | ComparativePredicateOf1 (i a)
p i a
x i a
y = [i a -> Interval a -> i a
forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval i a
y (i a -> i a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval i a
x i a
y)]
| Bool
otherwise = i a -> [i a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure i a
x [i a] -> [i a] -> [i a]
forall a. Semigroup a => a -> a -> a
<> i a -> [i a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure i a
y
disjoinPaired
:: (Eq b, Monoid b, Show a, IntervalSizeable a c)
=> (PairedInterval b) a
-> (PairedInterval b) a
-> Meeting [(PairedInterval b) a]
disjoinPaired :: PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
disjoinPaired PairedInterval b a
o PairedInterval b a
e = case PairedInterval b a -> PairedInterval b a -> IntervalRelation
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> i1 a -> IntervalRelation
relate PairedInterval b a
x PairedInterval b a
y of
IntervalRelation
Before -> [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [PairedInterval b a
x, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
e1 a
b2 b
forall a. Monoid a => a
mempty, PairedInterval b a
y]
IntervalRelation
Meets -> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [PairedInterval b a
x, PairedInterval b a
y]
IntervalRelation
Overlaps -> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b2 a
e1 b
sc, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
e1 a
e2 b
s2]
IntervalRelation
FinishedBy -> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev Interval a
i2 b
sc]
IntervalRelation
Contains -> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b1 a
b2 b
s1, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
b2 a
e2 b
sc, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
e2 a
e1 b
s1]
IntervalRelation
Starts -> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall b a.
(Eq b, Ord a, Show a) =>
Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
foldMeeting (Meeting [PairedInterval b a] -> Meeting [PairedInterval b a])
-> Meeting [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev Interval a
i1 b
sc, a -> a -> b -> PairedInterval b a
forall a b b.
IntervalSizeable a b =>
a -> a -> b -> PairedInterval b a
evp a
e1 a
e2 b
s2]
IntervalRelation
_ -> [PairedInterval b a] -> Meeting [PairedInterval b a]
forall a. a -> Meeting a
Meeting [Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev Interval a
i1 b
sc]
where
x :: PairedInterval b a
x = PairedInterval b a -> PairedInterval b a -> PairedInterval b a
forall a. Ord a => a -> a -> a
min PairedInterval b a
o PairedInterval b a
e
y :: PairedInterval b a
y = PairedInterval b a -> PairedInterval b a -> PairedInterval b a
forall a. Ord a => a -> a -> a
max PairedInterval b a
o PairedInterval b a
e
i1 :: Interval a
i1 = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval PairedInterval b a
x
i2 :: Interval a
i2 = PairedInterval b a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval PairedInterval b a
y
s1 :: b
s1 = PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
x
s2 :: b
s2 = PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData PairedInterval b a
y
sc :: b
sc = b
s1 b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
s2
b1 :: a
b1 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin PairedInterval b a
x
b2 :: a
b2 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin PairedInterval b a
y
e1 :: a
e1 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end PairedInterval b a
x
e2 :: a
e2 = PairedInterval b a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end PairedInterval b a
y
ev :: Interval a -> b -> PairedInterval b a
ev = (b -> Interval a -> PairedInterval b a)
-> Interval a -> b -> PairedInterval b a
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> Interval a -> PairedInterval b a
forall b a. b -> Interval a -> PairedInterval b a
makePairedInterval
evp :: a -> a -> b -> PairedInterval b a
evp a
b a
e = Interval a -> b -> PairedInterval b a
forall a b. Interval a -> b -> PairedInterval b a
ev (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff a
e a
b) a
b)
{-# INLINABLE disjoinPaired #-}
recurseDisjoin
:: (Monoid b, Eq b, IntervalSizeable a c, Show a)
=> ([(PairedInterval b) a], [(PairedInterval b) a])
-> [(PairedInterval b) a]
-> [(PairedInterval b) a]
recurseDisjoin :: ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([PairedInterval b a]
acc, PairedInterval b a
o : [PairedInterval b a]
os) [] = [PairedInterval b a]
acc [PairedInterval b a]
-> [PairedInterval b a] -> [PairedInterval b a]
forall a. Semigroup a => a -> a -> a
<> (PairedInterval b a
o PairedInterval b a -> [PairedInterval b a] -> [PairedInterval b a]
forall a. a -> [a] -> [a]
: [PairedInterval b a]
os)
recurseDisjoin ([PairedInterval b a]
acc, [] ) [] = [PairedInterval b a]
acc
recurseDisjoin ([PairedInterval b a]
acc, [] ) (PairedInterval b a
e : [PairedInterval b a]
es) = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([PairedInterval b a]
acc, [PairedInterval b a
e]) [PairedInterval b a]
es
recurseDisjoin ([PairedInterval b a]
acc, PairedInterval b a
o : [PairedInterval b a]
os) (PairedInterval b a
e : [PairedInterval b a]
es)
|
PairedInterval b a
e PairedInterval b a -> PairedInterval b a -> Bool
forall a. Eq a => a -> a -> Bool
== PairedInterval b a
o = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([PairedInterval b a]
acc, PairedInterval b a
o PairedInterval b a -> [PairedInterval b a] -> [PairedInterval b a]
forall a. a -> [a] -> [a]
: [PairedInterval b a]
os) [PairedInterval b a]
es
|
(PairedInterval b a -> PairedInterval b a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before (PairedInterval b a -> PairedInterval b a -> Bool)
-> (PairedInterval b a -> PairedInterval b a -> Bool)
-> PairedInterval b a
-> PairedInterval b a
-> Bool
forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
<|> PairedInterval b a -> PairedInterval b a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets) PairedInterval b a
o PairedInterval b a
e = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin
([PairedInterval b a]
acc [PairedInterval b a]
-> [PairedInterval b a] -> [PairedInterval b a]
forall a. Semigroup a => a -> a -> a
<> [PairedInterval b a]
nh, ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([], [PairedInterval b a]
nt) [PairedInterval b a]
os)
[PairedInterval b a]
es
|
Bool
otherwise = ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([PairedInterval b a]
acc, ([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([], [PairedInterval b a]
n) [PairedInterval b a]
os) [PairedInterval b a]
es
where
n :: [PairedInterval b a]
n = Meeting [PairedInterval b a] -> [PairedInterval b a]
forall a. Meeting a -> a
getMeeting (Meeting [PairedInterval b a] -> [PairedInterval b a])
-> Meeting [PairedInterval b a] -> [PairedInterval b a]
forall a b. (a -> b) -> a -> b
$ PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
forall b a c.
(Eq b, Monoid b, Show a, IntervalSizeable a c) =>
PairedInterval b a
-> PairedInterval b a -> Meeting [PairedInterval b a]
disjoinPaired PairedInterval b a
o PairedInterval b a
e
nh :: [PairedInterval b a]
nh = Maybe (PairedInterval b a) -> [PairedInterval b a]
forall a. Maybe a -> [a]
maybeToList ([PairedInterval b a] -> Maybe (PairedInterval b a)
forall a. [a] -> Maybe a
headMay [PairedInterval b a]
n)
nt :: [PairedInterval b a]
nt = [PairedInterval b a] -> [PairedInterval b a]
forall a. [a] -> [a]
tailSafe [PairedInterval b a]
n
{-# INLINABLE recurseDisjoin #-}
formMeetingSequence
:: (Eq b, Show a, Monoid b, IntervalSizeable a c)
=> [PairedInterval b a]
-> [PairedInterval b a]
formMeetingSequence :: [PairedInterval b a] -> [PairedInterval b a]
formMeetingSequence [PairedInterval b a]
x
| [PairedInterval b a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PairedInterval b a]
x = []
| [PairedInterval b a] -> Bool
forall a b. Ord a => [PairedInterval b a] -> Bool
allMeet [PairedInterval b a]
x Bool -> Bool -> Bool
&& Bool -> Bool
not ([PairedInterval b a] -> Bool
forall b a. Eq b => [PairedInterval b a] -> Bool
hasEqData [PairedInterval b a]
x) = [PairedInterval b a]
x
| Bool
otherwise = [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Eq b, Show a, Monoid b, IntervalSizeable a c) =>
[PairedInterval b a] -> [PairedInterval b a]
formMeetingSequence (([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
forall b a c.
(Monoid b, Eq b, IntervalSizeable a c, Show a) =>
([PairedInterval b a], [PairedInterval b a])
-> [PairedInterval b a] -> [PairedInterval b a]
recurseDisjoin ([], []) [PairedInterval b a]
x)
{-# INLINABLE formMeetingSequence #-}
allMeet :: (Ord a) => [PairedInterval b a] -> Bool
allMeet :: [PairedInterval b a] -> Bool
allMeet [PairedInterval b a]
x = (IntervalRelation -> Bool) -> [IntervalRelation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Meets) ([PairedInterval b a] -> [IntervalRelation]
forall (f :: * -> *) a (i :: * -> *).
(Foldable f, Ord a, Intervallic i) =>
f (i a) -> [IntervalRelation]
relationsL [PairedInterval b a]
x)
hasEqData :: (Eq b) => [PairedInterval b a] -> Bool
hasEqData :: [PairedInterval b a] -> Bool
hasEqData [PairedInterval b a]
x = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Fold b [Bool] -> [b] -> [Bool]
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold ((b -> b -> Bool) -> Fold b [Bool]
forall (m :: * -> *) b a.
(Monoid (m b), Applicative m) =>
(a -> a -> b) -> Fold a (m b)
makeFolder b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((PairedInterval b a -> b) -> [PairedInterval b a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PairedInterval b a -> b
forall b a. PairedInterval b a -> b
getPairData [PairedInterval b a]
x) :: [Bool])