-- | Basic temporal sequence functions.
module Music.Theory.Time.Seq where

import Data.Bifunctor {- base -}
import Data.Function {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ratio {- base -}
import Safe {- safe -}

import qualified Data.List.Ordered as O {- data-ordlist -}
import qualified Data.Map as Map {- containers -}

import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.Math as T {- hmt-base -}
import qualified Music.Theory.Ord as T {- hmt-base -}
import qualified Music.Theory.Tuple as T {- hmt-base -}

-- * Types

-- | Sequence of elements with uniform duration.
type Useq t a = (t,[a])

-- | Duration sequence.
-- /t/ indicates the /forward/ duration of the value, ie. the interval to the next value.
-- If there are other durations they must be encoded at /a/.
-- If the sequence does not begin at time zero there must be an /empty/ value for /a/.
type Dseq t a = [(t,a)]

-- | Inter-offset sequence.
-- /t/ is the interval /before/ the value.
-- Duration can be encoded at /a/, or if implicit /a/ must include an end of sequence value.
type Iseq t a = [(t,a)]

-- | Pattern sequence.
-- The duration is a triple of /logical/, /sounding/ and /forward/ durations.
-- These indicate the time the value conceptually takes, the time it actually takes, and the time to the next event.
-- If the sequence does not begin at time zero there must be an /empty/ value for /a/.
type Pseq t a = [((t,t,t),a)]

-- | Time-point sequence.
-- /t/ is the start time of the value.
-- To express holes /a/ must have an /empty/ value.
-- Duration can be encoded at /a/, or if implicit /a/ must include an end of sequence value.
type Tseq t a = [(t,a)]

-- | Window sequence.
-- /t/ is a duple of /start-time/ and /duration/.
-- Holes exist where /start-time(n) + duration(n) < start-time(n + 1)/.
-- Overlaps exist where the same relation is '>'.
type Wseq t a = [((t,t),a)]

-- | Event sequence.
-- /t/ is a triple of /start-time/, /duration/ and /length/.
-- /length/ isn't necessarily the time to the next event, though ordinarily it should not be greater than that interval.
type Eseq t a = [((t,t,t),a)]

-- * Zip

-- | Construct 'Pseq'.
pseq_zip :: [t] -> [t] -> [t] -> [a] -> Pseq t a
pseq_zip :: forall t a. [t] -> [t] -> [t] -> [a] -> Pseq t a
pseq_zip [t]
l [t]
o [t]
f = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [t]
l [t]
o [t]
f)

-- | Construct 'Wseq'.
wseq_zip :: [t] -> [t] -> [a] -> Wseq t a
wseq_zip :: forall t a. [t] -> [t] -> [a] -> Wseq t a
wseq_zip [t]
t [t]
d = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> [(a, b)]
zip [t]
t [t]
d)

-- * Time span

-- | Given functions for deriving start and end times calculate time span of sequence.
--   Requires sequence be finite.
--
-- > seq_tspan id id [] == (0,0)
-- > seq_tspan id id (zip [0..9] ['a'..]) == (0,9)
seq_tspan :: Num n => (t -> n) -> (t -> n) -> [(t,a)] -> (n,n)
seq_tspan :: forall n t a. Num n => (t -> n) -> (t -> n) -> [(t, a)] -> (n, n)
seq_tspan t -> n
st t -> n
et [(t, a)]
sq =
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe n
0 (t -> n
st forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. [a] -> Maybe a
headMay [(t, a)]
sq)
    ,forall b a. b -> (a -> b) -> Maybe a -> b
maybe n
0 (t -> n
et forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. [a] -> Maybe a
lastMay [(t, a)]
sq))

-- | 'seq_tspan' for 'Tseq'.
tseq_tspan :: Num t => Tseq t a -> (t,t)
tseq_tspan :: forall t a. Num t => Tseq t a -> (t, t)
tseq_tspan = forall n t a. Num n => (t -> n) -> (t -> n) -> [(t, a)] -> (n, n)
seq_tspan forall a. a -> a
id forall a. a -> a
id

-- | 'seq_tspan' for 'Wseq'.
wseq_tspan :: Num t => Wseq t a -> (t,t)
wseq_tspan :: forall t a. Num t => Wseq t a -> (t, t)
wseq_tspan = forall n t a. Num n => (t -> n) -> (t -> n) -> [(t, a)] -> (n, n)
seq_tspan forall a b. (a, b) -> a
fst (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
(+))

-- | Start time of sequence.
--
-- > wseq_start [((1,2),'a')] == 1
-- > wseq_start [] == 0
wseq_start :: Num t => Wseq t a -> t
wseq_start :: forall t a. Num t => Wseq t a -> t
wseq_start = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Wseq t a -> (t, t)
wseq_tspan

-- | End time of sequence.
--
-- > wseq_end [((1,2),'a')] == 3
-- > wseq_end (useq_to_wseq 0 (1,"linear")) == 6
wseq_end :: Num t => Wseq t a -> t
wseq_end :: forall t a. Num t => Wseq t a -> t
wseq_end = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Wseq t a -> (t, t)
wseq_tspan

-- * Duration

-- | Sum durations at 'Dseq', result is the end time of the last element.
dseq_dur :: Num t => Dseq t a -> t
dseq_dur :: forall t a. Num t => Dseq t a -> t
dseq_dur = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

-- | Sum durations at 'Iseq', result is the start time of the last element.
iseq_dur :: Num t => Iseq t a -> t
iseq_dur :: forall t a. Num t => Dseq t a -> t
iseq_dur = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

-- | Sum durations at 'Pseq', result is the end time of the last element.
pseq_dur :: Num t => Pseq t a -> t
pseq_dur :: forall t a. Num t => Pseq t a -> t
pseq_dur = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall t. T3 t -> t
T.t3_third forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | The interval of 'tseq_tspan', ie. from the start of the first element to the start of the last.
--
-- > tseq_dur (zip [0..] "abcde|") == 5
tseq_dur :: Num t => Tseq t a -> t
tseq_dur :: forall t a. Num t => Dseq t a -> t
tseq_dur = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
subtract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Tseq t a -> (t, t)
tseq_tspan

-- | The interval of 'wseq_tspan', ie. from the start of the first element to the end of the last.
--
-- > wseq_dur (zip (zip [0..] (repeat 2)) "abcde") == 6
wseq_dur :: Num t => Wseq t a -> t
wseq_dur :: forall t a. Num t => Wseq t a -> t
wseq_dur = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
subtract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Wseq t a -> (t, t)
wseq_tspan

-- * Window

-- | Prefix of sequence where the start time precedes or is at the indicated time.
wseq_until :: Ord t => t -> Wseq t a -> Wseq t a
wseq_until :: forall t a. Ord t => t -> Wseq t a -> Wseq t a
wseq_until t
tm = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\((t
t0,t
_),a
_) -> t
t0 forall a. Ord a => a -> a -> Bool
<= t
tm)

-- | Keep only elements that are entirely contained within the indicated
-- temporal window, which is inclusive at the left & right
-- edges, ie. [t0,t1].  Halts processing at end of window.
--
-- > let r = [((5,1),'e'),((6,1),'f'),((7,1),'g'),((8,1),'h')]
-- > wseq_twindow (5,9) (zip (zip [1..] (repeat 1)) ['a'..]) == r
--
-- > wseq_twindow (1,2) [((1,1),'a'),((1,2),'b')] == [((1,1),'a')]
wseq_twindow :: (Num t, Ord t) => (t,t) -> Wseq t a -> Wseq t a
wseq_twindow :: forall t a. (Num t, Ord t) => (t, t) -> Wseq t a -> Wseq t a
wseq_twindow (t
w0,t
w1) =
    let f :: (t, t) -> Bool
f (t
st,t
du) = t
w0 forall a. Ord a => a -> a -> Bool
<= t
st Bool -> Bool -> Bool
&& (t
st forall a. Num a => a -> a -> a
+ t
du) forall a. Ord a => a -> a -> Bool
<= t
w1
    in forall t a. ((t, t) -> Bool) -> Wseq t a -> Wseq t a
wseq_tfilter (t, t) -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Ord t => t -> Wseq t a -> Wseq t a
wseq_until t
w1

-- | Select nodes that are active at indicated time, comparison is
-- inclusive at left and exclusive at right.  Halts processing at end
-- of window.
--
-- > let sq = [((1,1),'a'),((1,2),'b')]
-- > map (wseq_at sq) [1,2] == [sq,[((1,2),'b')]]
--
-- > wseq_at (zip (zip [1..] (repeat 1)) ['a'..]) 3 == [((3,1),'c')]
wseq_at :: (Num t,Ord t) => Wseq t a -> t -> Wseq t a
wseq_at :: forall t a. (Num t, Ord t) => Wseq t a -> t -> Wseq t a
wseq_at Wseq t a
sq t
tm =
    let sel :: ((t, t), b) -> Bool
sel ((t
t0,t
t1),b
_) = t
t0 forall a. Ord a => a -> a -> Bool
<= t
tm Bool -> Bool -> Bool
&& t
tm forall a. Ord a => a -> a -> Bool
< (t
t0 forall a. Num a => a -> a -> a
+ t
t1)
        end :: ((t, b), b) -> Bool
end ((t
t0,b
_),b
_) = t
t0 forall a. Ord a => a -> a -> Bool
<= t
tm
    in forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. ((t, t), b) -> Bool
sel (forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall {b} {b}. ((t, b), b) -> Bool
end Wseq t a
sq)

-- | Select nodes that are active within the indicated window, comparison is
-- inclusive at left and exclusive at right.  Halts processing at end
-- of window.
--
-- > let sq = [((0,2),'a'),((0,4),'b'),((2,4),'c')]
-- > wseq_at_window sq (1,3) == sq
--
-- > wseq_at_window (zip (zip [1..] (repeat 1)) ['a'..]) (3,4) == [((3,1),'c'),((4,1),'d')]
wseq_at_window :: (Num t, Ord t) => Wseq t a -> (t,t) -> Wseq t a
wseq_at_window :: forall t a. (Num t, Ord t) => Wseq t a -> (t, t) -> Wseq t a
wseq_at_window Wseq t a
sq (t
w0,t
w1) =
    let f :: (a, a) -> a -> Bool
f (a
t0,a
t1) a
t = a
t0 forall a. Ord a => a -> a -> Bool
<= a
t Bool -> Bool -> Bool
&& a
t forall a. Ord a => a -> a -> Bool
< a
t1
        g :: (t, t) -> Bool
g (t
st,t
du) = let w :: (t, t)
w = (t
st,t
st forall a. Num a => a -> a -> a
+ t
du) in forall {a}. Ord a => (a, a) -> a -> Bool
f (t, t)
w t
w0 Bool -> Bool -> Bool
|| forall {a}. Ord a => (a, a) -> a -> Bool
f (t, t)
w t
w1
    in forall t a. ((t, t) -> Bool) -> Wseq t a -> Wseq t a
wseq_tfilter (t, t) -> Bool
g (forall t a. Ord t => t -> Wseq t a -> Wseq t a
wseq_until t
w1 Wseq t a
sq)

-- * Append

-- | Type specialised '++'
dseq_append :: Dseq t a -> Dseq t a -> Dseq t a
dseq_append :: forall t a. Dseq t a -> Dseq t a -> Dseq t a
dseq_append = forall a. [a] -> [a] -> [a]
(++)

-- | Type specialised '++'
iseq_append :: Iseq t a -> Iseq t a -> Iseq t a
iseq_append :: forall t a. Dseq t a -> Dseq t a -> Dseq t a
iseq_append = forall a. [a] -> [a] -> [a]
(++)

-- | Type specialised '++'
pseq_append :: Pseq t a -> Pseq t a -> Pseq t a
pseq_append :: forall t a. Pseq t a -> Pseq t a -> Pseq t a
pseq_append = forall a. [a] -> [a] -> [a]
(++)

-- * Merge

-- | Merge comparing only on time.
tseq_merge :: Ord t => Tseq t a -> Tseq t a -> Tseq t a
tseq_merge :: forall t a. Ord t => Tseq t a -> Tseq t a -> Tseq t a
tseq_merge = forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
O.mergeBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)

-- | Merge, where times are equal compare values.
tseq_merge_by :: Ord t => T.Compare_F a -> Tseq t a -> Tseq t a -> Tseq t a
tseq_merge_by :: forall t a.
Ord t =>
Compare_F a -> Tseq t a -> Tseq t a -> Tseq t a
tseq_merge_by Compare_F a
cmp = forall b a c.
Ord b =>
(a -> b) -> Compare_F c -> (a -> c) -> [a] -> [a] -> [a]
T.merge_by_two_stage forall a b. (a, b) -> a
fst Compare_F a
cmp forall a b. (a, b) -> b
snd

{- | Merge, where times are equal apply /f/ to form a single value.

> let {p = zip [1,3,5] "abc"
>     ;q = zip [1,2,3] "ABC"
>     ;left_r = [(1,'a'),(2,'B'),(3,'b'),(5,'c')]
>     ;right_r = [(1,'A'),(2,'B'),(3,'C'),(5,'c')]}
> in tseq_merge_resolve (\x _ -> x) p q == left_r &&
>    tseq_merge_resolve (\_ x -> x) p q == right_r

-}
tseq_merge_resolve :: Ord t => (a -> a -> a) -> Tseq t a -> Tseq t a -> Tseq t a
tseq_merge_resolve :: forall t a.
Ord t =>
(a -> a -> a) -> Tseq t a -> Tseq t a -> Tseq t a
tseq_merge_resolve a -> a -> a
f =
    let cmp :: (t, b) -> (t, b) -> Ordering
cmp = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst
        g :: (a, a) -> (a, a) -> (a, a)
g (a
t,a
p) (a
_,a
q) = (a
t,a -> a -> a
f a
p a
q)
    in forall a. (a -> a -> a) -> Compare_F a -> [a] -> [a] -> [a]
T.merge_by_resolve forall {a} {a}. (a, a) -> (a, a) -> (a, a)
g forall {b}. (t, b) -> (t, b) -> Ordering
cmp

-- | Compare first by start time, then by duration.
w_compare :: Ord t => ((t,t),a) -> ((t,t),a) -> Ordering
w_compare :: forall t a. Ord t => ((t, t), a) -> ((t, t), a) -> Ordering
w_compare ((t
t1,t
d1),a
_) ((t
t2,t
d2),a
_) =
    case forall a. Ord a => a -> a -> Ordering
compare t
t1 t
t2 of
      Ordering
EQ -> forall a. Ord a => a -> a -> Ordering
compare t
d1 t
d2
      Ordering
r -> Ordering
r

-- | Merge considering only start times.
wseq_merge :: Ord t => Wseq t a -> Wseq t a -> Wseq t a
wseq_merge :: forall t a. Ord t => Wseq t a -> Wseq t a -> Wseq t a
wseq_merge = forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
O.mergeBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))

-- | Merge set considering both start times & durations.
wseq_merge_set :: Ord t => [Wseq t a] -> Wseq t a
wseq_merge_set :: forall t a. Ord t => [Wseq t a] -> Wseq t a
wseq_merge_set = forall a. (a -> a -> Ordering) -> [[a]] -> [a]
T.merge_set_by forall t a. Ord t => ((t, t), a) -> ((t, t), a) -> Ordering
w_compare

-- | Merge considering only start times.
eseq_merge :: Ord t => Eseq t a -> Eseq t a -> Eseq t a
eseq_merge :: forall t a. Ord t => Eseq t a -> Eseq t a -> Eseq t a
eseq_merge = forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
O.mergeBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall t. T3 t -> t
T.t3_fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))

-- * Lookup

-- | Locate nodes to the left and right of indicated time.
tseq_lookup_window_by :: (t -> t -> Ordering) -> Tseq t e -> t -> (Maybe (t,e),Maybe (t,e))
tseq_lookup_window_by :: forall t e.
(t -> t -> Ordering)
-> Tseq t e -> t -> (Maybe (t, e), Maybe (t, e))
tseq_lookup_window_by t -> t -> Ordering
cmp =
    let recur :: Maybe (t, b) -> [(t, b)] -> t -> (Maybe (t, b), Maybe (t, b))
recur Maybe (t, b)
l [(t, b)]
sq t
t =
            case [(t, b)]
sq of
              [] -> (Maybe (t, b)
l,forall a. Maybe a
Nothing)
              (t
t',b
e):[(t, b)]
sq' -> case t -> t -> Ordering
cmp t
t t
t' of
                              Ordering
LT -> (Maybe (t, b)
l,forall a. a -> Maybe a
Just (t
t',b
e))
                              Ordering
_ -> case [(t, b)]
sq' of
                                     [] -> (forall a. a -> Maybe a
Just (t
t',b
e),forall a. Maybe a
Nothing)
                                     (t
t'',b
e'):[(t, b)]
_ -> case t -> t -> Ordering
cmp t
t t
t'' of
                                                     Ordering
LT -> (forall a. a -> Maybe a
Just (t
t',b
e),forall a. a -> Maybe a
Just (t
t'',b
e'))
                                                     Ordering
_ -> Maybe (t, b) -> [(t, b)] -> t -> (Maybe (t, b), Maybe (t, b))
recur (forall a. a -> Maybe a
Just (t
t',b
e)) [(t, b)]
sq' t
t
    in forall {b}.
Maybe (t, b) -> [(t, b)] -> t -> (Maybe (t, b), Maybe (t, b))
recur forall a. Maybe a
Nothing

tseq_lookup_active_by :: (t -> t -> Ordering) -> Tseq t e -> t -> Maybe e
tseq_lookup_active_by :: forall t e. (t -> t -> Ordering) -> Tseq t e -> t -> Maybe e
tseq_lookup_active_by t -> t -> Ordering
cmp Tseq t e
sq = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t e.
(t -> t -> Ordering)
-> Tseq t e -> t -> (Maybe (t, e), Maybe (t, e))
tseq_lookup_window_by t -> t -> Ordering
cmp Tseq t e
sq

tseq_lookup_active :: Ord t => Tseq t e -> t -> Maybe e
tseq_lookup_active :: forall t e. Ord t => Tseq t e -> t -> Maybe e
tseq_lookup_active = forall t e. (t -> t -> Ordering) -> Tseq t e -> t -> Maybe e
tseq_lookup_active_by forall a. Ord a => a -> a -> Ordering
compare

tseq_lookup_active_by_def :: e -> (t -> t -> Ordering) -> Tseq t e -> t -> e
tseq_lookup_active_by_def :: forall e t. e -> (t -> t -> Ordering) -> Tseq t e -> t -> e
tseq_lookup_active_by_def e
def t -> t -> Ordering
cmp Tseq t e
sq = forall a. a -> Maybe a -> a
fromMaybe e
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t e. (t -> t -> Ordering) -> Tseq t e -> t -> Maybe e
tseq_lookup_active_by t -> t -> Ordering
cmp Tseq t e
sq

tseq_lookup_active_def :: Ord t => e -> Tseq t e -> t -> e
tseq_lookup_active_def :: forall t e. Ord t => e -> Tseq t e -> t -> e
tseq_lookup_active_def e
def = forall e t. e -> (t -> t -> Ordering) -> Tseq t e -> t -> e
tseq_lookup_active_by_def e
def forall a. Ord a => a -> a -> Ordering
compare

-- * Lseq

-- | Iterpolation type enumeration.
data Interpolation_T =
  None | Linear
  deriving (Interpolation_T -> Interpolation_T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interpolation_T -> Interpolation_T -> Bool
$c/= :: Interpolation_T -> Interpolation_T -> Bool
== :: Interpolation_T -> Interpolation_T -> Bool
$c== :: Interpolation_T -> Interpolation_T -> Bool
Eq,Int -> Interpolation_T
Interpolation_T -> Int
Interpolation_T -> [Interpolation_T]
Interpolation_T -> Interpolation_T
Interpolation_T -> Interpolation_T -> [Interpolation_T]
Interpolation_T
-> Interpolation_T -> Interpolation_T -> [Interpolation_T]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Interpolation_T
-> Interpolation_T -> Interpolation_T -> [Interpolation_T]
$cenumFromThenTo :: Interpolation_T
-> Interpolation_T -> Interpolation_T -> [Interpolation_T]
enumFromTo :: Interpolation_T -> Interpolation_T -> [Interpolation_T]
$cenumFromTo :: Interpolation_T -> Interpolation_T -> [Interpolation_T]
enumFromThen :: Interpolation_T -> Interpolation_T -> [Interpolation_T]
$cenumFromThen :: Interpolation_T -> Interpolation_T -> [Interpolation_T]
enumFrom :: Interpolation_T -> [Interpolation_T]
$cenumFrom :: Interpolation_T -> [Interpolation_T]
fromEnum :: Interpolation_T -> Int
$cfromEnum :: Interpolation_T -> Int
toEnum :: Int -> Interpolation_T
$ctoEnum :: Int -> Interpolation_T
pred :: Interpolation_T -> Interpolation_T
$cpred :: Interpolation_T -> Interpolation_T
succ :: Interpolation_T -> Interpolation_T
$csucc :: Interpolation_T -> Interpolation_T
Enum,Int -> Interpolation_T -> ShowS
[Interpolation_T] -> ShowS
Interpolation_T -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interpolation_T] -> ShowS
$cshowList :: [Interpolation_T] -> ShowS
show :: Interpolation_T -> String
$cshow :: Interpolation_T -> String
showsPrec :: Int -> Interpolation_T -> ShowS
$cshowsPrec :: Int -> Interpolation_T -> ShowS
Show)

-- | Variant of 'Tseq' where nodes have an 'Intepolation_T' value.
type Lseq t a = Tseq (t,Interpolation_T) a

{- | Linear interpolation.
     The Real constraint on t is to allow conversion from t to e (realToFrac).
-}
lerp :: (Fractional t,Real t,Fractional e) => (t,e) -> (t,e) -> t -> e
lerp :: forall t e.
(Fractional t, Real t, Fractional e) =>
(t, e) -> (t, e) -> t -> e
lerp (t
t0,e
e0) (t
t1,e
e1) t
t =
    let n :: t
n = t
t1 forall a. Num a => a -> a -> a
- t
t0
        m :: t
m = t
t forall a. Num a => a -> a -> a
- t
t0
        l :: t
l = t
m forall a. Fractional a => a -> a -> a
/ t
n
    in forall a b. (Real a, Fractional b) => a -> b
realToFrac t
l forall a. Num a => a -> a -> a
* (e
e1 forall a. Num a => a -> a -> a
- e
e0) forall a. Num a => a -> a -> a
+ e
e0

-- | Temporal map.
lseq_tmap :: (t -> t') -> Lseq t a -> Lseq t' a
lseq_tmap :: forall t t' a. (t -> t') -> Lseq t a -> Lseq t' a
lseq_tmap t -> t'
f = let g :: ((t, b), b) -> ((t', b), b)
g ((t
t,b
i),b
e) = ((t -> t'
f t
t,b
i),b
e) in forall a b. (a -> b) -> [a] -> [b]
map forall {b} {b}. ((t, b), b) -> ((t', b), b)
g

-- | This can give 'Nothing' if /t/ precedes the 'Lseq' or if /t/ is
-- after the final element of 'Lseq' and that element has an
-- interpolation type other than 'None'.
lseq_lookup :: (Fractional t,Real t,Fractional e) => (t -> t -> Ordering) -> Lseq t e -> t -> Maybe e
lseq_lookup :: forall t e.
(Fractional t, Real t, Fractional e) =>
(t -> t -> Ordering) -> Lseq t e -> t -> Maybe e
lseq_lookup t -> t -> Ordering
cmp Lseq t e
sq t
t =
    case forall t e.
(t -> t -> Ordering)
-> Tseq t e -> t -> (Maybe (t, e), Maybe (t, e))
tseq_lookup_window_by (t -> t -> Ordering
cmp forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) Lseq t e
sq (t
t,forall a. HasCallStack => a
undefined) of
      (Maybe ((t, Interpolation_T), e)
Nothing,Maybe ((t, Interpolation_T), e)
_) -> forall a. Maybe a
Nothing
      (Just ((t
_,Interpolation_T
None),e
e),Maybe ((t, Interpolation_T), e)
_) -> forall a. a -> Maybe a
Just e
e
      (Just ((t
t0,Interpolation_T
Linear),e
e0),Just ((t
t1,Interpolation_T
_),e
e1)) -> forall a. a -> Maybe a
Just (forall t e.
(Fractional t, Real t, Fractional e) =>
(t, e) -> (t, e) -> t -> e
lerp (t
t0,e
e0) (t
t1,e
e1) t
t)
      (Maybe ((t, Interpolation_T), e), Maybe ((t, Interpolation_T), e))
_ -> forall a. Maybe a
Nothing

-- | 'error'ing variant.
lseq_lookup_err :: (Fractional t,Real t,Fractional e) => (t -> t -> Ordering) -> Lseq t e -> t -> e
lseq_lookup_err :: forall t e.
(Fractional t, Real t, Fractional e) =>
(t -> t -> Ordering) -> Lseq t e -> t -> e
lseq_lookup_err t -> t -> Ordering
cmp Lseq t e
sq = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"lseq_lookup") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t e.
(Fractional t, Real t, Fractional e) =>
(t -> t -> Ordering) -> Lseq t e -> t -> Maybe e
lseq_lookup t -> t -> Ordering
cmp Lseq t e
sq

-- * Map, Filter, Find

-- | 'map' over time (/t/) data.
seq_tmap :: (t1 -> t2) -> [(t1,a)] -> [(t2,a)]
seq_tmap :: forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap t1 -> t2
f = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first t1 -> t2
f)

-- | 'map' over element (/e/) data.
seq_map :: (e1 -> e2) -> [(t,e1)] -> [(t,e2)]
seq_map :: forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
seq_map e1 -> e2
f = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second e1 -> e2
f)

-- | 'map' /t/ and /e/ simultaneously.
--
-- > seq_bimap negate succ (zip [1..5] [0..4]) == [(-1,1),(-2,2),(-3,3),(-4,4),(-5,5)]
seq_bimap :: (t1 -> t2) -> (e1 -> e2) -> [(t1,e1)] -> [(t2,e2)]
seq_bimap :: forall t1 t2 e1 e2.
(t1 -> t2) -> (e1 -> e2) -> [(t1, e1)] -> [(t2, e2)]
seq_bimap t1 -> t2
f = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap t1 -> t2
f

-- | 'filter' over time (/t/) data.
seq_tfilter :: (t -> Bool) -> [(t,a)] -> [(t,a)]
seq_tfilter :: forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_tfilter t -> Bool
f = forall a. (a -> Bool) -> [a] -> [a]
filter (t -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | 'filter' over element (/e/) data.
seq_filter :: (b -> Bool) -> [(a,b)] -> [(a,b)]
seq_filter :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_filter b -> Bool
f = forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- | 'find' over element (/e/) data.
seq_find :: (e -> Bool) -> [(t,e)] -> Maybe (t,e)
seq_find :: forall e t. (e -> Bool) -> [(t, e)] -> Maybe (t, e)
seq_find e -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- * Maybe

-- | 'mapMaybe' variant.
seq_map_maybe :: (p -> Maybe q) -> [(t,p)] -> [(t,q)]
seq_map_maybe :: forall p q t. (p -> Maybe q) -> [(t, p)] -> [(t, q)]
seq_map_maybe p -> Maybe q
f =
    let g :: (a, p) -> Maybe (a, q)
g (a
t,p
e) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\q
e' -> (a
t,q
e')) (p -> Maybe q
f p
e)
    in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, p) -> Maybe (a, q)
g

-- | Variant of 'catMaybes'.
seq_cat_maybes :: [(t,Maybe q)] -> [(t,q)]
seq_cat_maybes :: forall t q. [(t, Maybe q)] -> [(t, q)]
seq_cat_maybes = forall p q t. (p -> Maybe q) -> [(t, p)] -> [(t, q)]
seq_map_maybe forall a. a -> a
id

-- | If value is unchanged at subsequent entry, according to /f/, replace with 'Nothing'.
seq_changed_by :: (a -> a -> Bool) -> [(t,a)] -> [(t,Maybe a)]
seq_changed_by :: forall a t. (a -> a -> Bool) -> [(t, a)] -> [(t, Maybe a)]
seq_changed_by a -> a -> Bool
f [(t, a)]
l =
    let recur :: a -> [(a, a)] -> [(a, Maybe a)]
recur a
z [(a, a)]
sq =
            case [(a, a)]
sq of
              [] -> []
              (a
t,a
e):[(a, a)]
sq' -> if a -> a -> Bool
f a
e a
z
                           then (a
t,forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: a -> [(a, a)] -> [(a, Maybe a)]
recur a
z [(a, a)]
sq'
                           else (a
t,forall a. a -> Maybe a
Just a
e) forall a. a -> [a] -> [a]
: a -> [(a, a)] -> [(a, Maybe a)]
recur a
e [(a, a)]
sq'
    in case [(t, a)]
l of
         [] -> []
         (t
t,a
e) : [(t, a)]
l' -> (t
t,forall a. a -> Maybe a
Just a
e) forall a. a -> [a] -> [a]
: forall {a}. a -> [(a, a)] -> [(a, Maybe a)]
recur a
e [(t, a)]
l'

-- | 'seq_changed_by' '=='.
--
-- > let r = [(1,'s'),(2,'t'),(4,'r'),(6,'i'),(7,'n'),(9,'g')]
-- > seq_cat_maybes (seq_changed (zip [1..] "sttrrinng")) == r
seq_changed :: Eq a => [(t,a)] -> [(t,Maybe a)]
seq_changed :: forall a t. Eq a => [(t, a)] -> [(t, Maybe a)]
seq_changed = forall a t. (a -> a -> Bool) -> [(t, a)] -> [(t, Maybe a)]
seq_changed_by forall a. Eq a => a -> a -> Bool
(==)

-- * Specialised temporal maps.

-- | Apply /f/ at time points of 'Wseq'.
wseq_tmap_st :: (t -> t) -> Wseq t a -> Wseq t a
wseq_tmap_st :: forall t a. (t -> t) -> Wseq t a -> Wseq t a
wseq_tmap_st t -> t
f = forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first t -> t
f)

-- | Apply /f/ at durations of elements of 'Wseq'.
wseq_tmap_dur :: (t -> t) -> Wseq t a -> Wseq t a
wseq_tmap_dur :: forall t a. (t -> t) -> Wseq t a -> Wseq t a
wseq_tmap_dur t -> t
f = forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second t -> t
f)

-- * Partition

-- | Given a function that determines a /voice/ for a value, partition
-- a sequence into voices.
seq_partition :: Ord v => (a -> v) -> [(t,a)] -> [(v,[(t,a)])]
seq_partition :: forall v a t. Ord v => (a -> v) -> [(t, a)] -> [(v, [(t, a)])]
seq_partition a -> v
voice [(t, a)]
sq =
    let assign :: Map v [(a, a)] -> (a, a) -> Map v [(a, a)]
assign Map v [(a, a)]
m (a
t,a
a) = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. [a] -> [a] -> [a]
(++) (a -> v
voice a
a) [(a
t,a
a)] Map v [(a, a)]
m
        from_map :: Map v [a] -> [(v, [a])]
from_map = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a. [a] -> [a]
reverse) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   forall k a. Map k a -> [(k, a)]
Map.toList
    in forall {a}. Map v [a] -> [(v, [a])]
from_map (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. Map v [(a, a)] -> (a, a) -> Map v [(a, a)]
assign forall k a. Map k a
Map.empty [(t, a)]
sq)

-- | Type specialised 'seq_partition'.
--
-- > let p = zip [0,1,3,5] (zip (repeat 0) "abcd")
-- > let q = zip [2,4,6,7] (zip (repeat 1) "ABCD")
-- > let sq = tseq_merge p q
-- > tseq_partition fst sq == [(0,p),(1,q)]
tseq_partition :: Ord v => (a -> v) -> Tseq t a -> [(v,Tseq t a)]
tseq_partition :: forall v a t. Ord v => (a -> v) -> [(t, a)] -> [(v, [(t, a)])]
tseq_partition = forall v a t. Ord v => (a -> v) -> [(t, a)] -> [(v, [(t, a)])]
seq_partition

-- | Type specialised 'seq_partition'.
wseq_partition :: Ord v => (a -> v) -> Wseq t a -> [(v,Wseq t a)]
wseq_partition :: forall v a t. Ord v => (a -> v) -> Wseq t a -> [(v, Wseq t a)]
wseq_partition = forall v a t. Ord v => (a -> v) -> [(t, a)] -> [(v, [(t, a)])]
seq_partition

-- * Coalesce

-- | Given a decision predicate and a join function, recursively join
-- adjacent elements.
--
-- > coalesce_f undefined undefined [] == []
-- > coalesce_f (==) const "abbcccbba" == "abcba"
-- > coalesce_f (==) (+) [1,2,2,3,3,3] == [1,4,6,3]
coalesce_f :: (t -> t -> Bool) -> (t -> t -> t) -> [t] -> [t]
coalesce_f :: forall t. (t -> t -> Bool) -> (t -> t -> t) -> [t] -> [t]
coalesce_f t -> t -> Bool
dec_f t -> t -> t
jn_f [t]
z =
    let recur :: t -> [t] -> [t]
recur t
p [t]
l =
            case [t]
l of
              [] -> [t
p]
              t
c:[t]
l' -> if t -> t -> Bool
dec_f t
p t
c
                      then t -> [t] -> [t]
recur (t -> t -> t
jn_f t
p t
c) [t]
l'
                      else t
p forall a. a -> [a] -> [a]
: t -> [t] -> [t]
recur t
c [t]
l'
    in case [t]
z of
         [] -> []
         t
e0:[t]
z' -> t -> [t] -> [t]
recur t
e0 [t]
z'

-- | 'coalesce_f' using 'mappend' for the join function.
coalesce_m :: Monoid t => (t -> t -> Bool) -> [t] -> [t]
coalesce_m :: forall t. Monoid t => (t -> t -> Bool) -> [t] -> [t]
coalesce_m t -> t -> Bool
dec_f = forall t. (t -> t -> Bool) -> (t -> t -> t) -> [t] -> [t]
coalesce_f t -> t -> Bool
dec_f forall a. Monoid a => a -> a -> a
mappend

-- | Form of 'coalesce_t' where the join predicate is on the /element/ only, the /times/ are summed.
coalesce_t :: Num t => ((t,a) -> (t,a) -> Bool) -> (a -> a -> a) -> [(t,a)] -> [(t,a)]
coalesce_t :: forall t a.
Num t =>
((t, a) -> (t, a) -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
coalesce_t (t, a) -> (t, a) -> Bool
dec_f a -> a -> a
jn_f = forall t. (t -> t -> Bool) -> (t -> t -> t) -> [t] -> [t]
coalesce_f (t, a) -> (t, a) -> Bool
dec_f (\(t
t1,a
a1) (t
t2,a
a2) -> (t
t1 forall a. Num a => a -> a -> a
+ t
t2,a -> a -> a
jn_f a
a1 a
a2))

{- | Form of 'coalesce_f' where both the decision and join predicates are on the/element/, the /times/ are summed.

> let r = [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
> seq_coalesce (==) const (useq_to_dseq (1,"abbcccdde")) == r
-}
seq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> [(t,a)] -> [(t,a)]
seq_coalesce :: forall t a.
Num t =>
(a -> a -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
seq_coalesce a -> a -> Bool
dec_f a -> a -> a
jn_f = forall t a.
Num t =>
((t, a) -> (t, a) -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
coalesce_t (a -> a -> Bool
dec_f forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd) a -> a -> a
jn_f

dseq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> Dseq t a -> Dseq t a
dseq_coalesce :: forall t a.
Num t =>
(a -> a -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
dseq_coalesce = forall t a.
Num t =>
(a -> a -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
seq_coalesce

-- | Given /equality/ predicate, simplify sequence by summing
-- durations of adjacent /equal/ elements.  This is a special case of
-- 'dseq_coalesce' where the /join/ function is 'const'.  The
-- implementation is simpler and non-recursive.
--
-- > let d = useq_to_dseq (1,"abbcccdde")
-- > let r = dseq_coalesce (==) const d
-- > dseq_coalesce' (==) d == r
dseq_coalesce' :: Num t => (a -> a -> Bool) -> Dseq t a -> Dseq t a
dseq_coalesce' :: forall t a. Num t => (a -> a -> Bool) -> Dseq t a -> Dseq t a
dseq_coalesce' a -> a -> Bool
eq =
    let f :: [(a, b)] -> (a, b)
f [(a, b)]
l = let ([a]
t,[b]
e) = forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
l in (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
t,forall a. [a] -> a
head [b]
e)
    in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. Num a => [(a, b)] -> (a, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (a -> a -> Bool
eq forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd)

iseq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> Iseq t a -> Iseq t a
iseq_coalesce :: forall t a.
Num t =>
(a -> a -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
iseq_coalesce = forall t a.
Num t =>
(a -> a -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
seq_coalesce

-- * T-coalesce

seq_tcoalesce :: (t -> t -> Bool) -> (a -> a -> a) -> [(t,a)] -> [(t,a)]
seq_tcoalesce :: forall t a.
(t -> t -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
seq_tcoalesce t -> t -> Bool
eq_f a -> a -> a
jn_f =
    let dec_f :: (t, b) -> (t, b) -> Bool
dec_f = t -> t -> Bool
eq_f forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst
        jn_f' :: (a, a) -> (a, a) -> (a, a)
jn_f' (a
t,a
a1) (a
_,a
a2) = (a
t,a -> a -> a
jn_f a
a1 a
a2)
    in forall t. (t -> t -> Bool) -> (t -> t -> t) -> [t] -> [t]
coalesce_f forall {b}. (t, b) -> (t, b) -> Bool
dec_f forall {a} {a}. (a, a) -> (a, a) -> (a, a)
jn_f'

tseq_tcoalesce :: Eq t => (a -> a -> a) -> Tseq t a -> Tseq t a
tseq_tcoalesce :: forall t a. Eq t => (a -> a -> a) -> Tseq t a -> Tseq t a
tseq_tcoalesce = forall t a.
(t -> t -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
seq_tcoalesce forall a. Eq a => a -> a -> Bool
(==)

-- | Type specialised 'seq_tcoalesce'.
wseq_tcoalesce :: ((t,t) -> (t,t) -> Bool) -> (a -> a -> a) -> Wseq t a -> Wseq t a
wseq_tcoalesce :: forall t a.
((t, t) -> (t, t) -> Bool) -> (a -> a -> a) -> Wseq t a -> Wseq t a
wseq_tcoalesce = forall t a.
(t -> t -> Bool) -> (a -> a -> a) -> [(t, a)] -> [(t, a)]
seq_tcoalesce

-- * Group

-- | Post-process 'groupBy' of /cmp/ 'on' 'fst'.
--
-- > let r = [(0,"a"),(1,"bc"),(2,"de"),(3,"f")]
-- > group_f (==) (zip [0,1,1,2,2,3] ['a'..]) == r
group_f :: (Eq t,Num t) => (t -> t -> Bool) -> [(t,a)] -> [(t,[a])]
group_f :: forall t a.
(Eq t, Num t) =>
(t -> t -> Bool) -> [(t, a)] -> [(t, [a])]
group_f t -> t -> Bool
cmp =
    let f :: [(a, b)] -> (a, [b])
f [(a, b)]
l = let ([a]
t,[b]
a) = forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
l
              in case [a]
t of
                   [] -> forall a. HasCallStack => String -> a
error String
"group_f: []?"
                   a
t0:[a]
_ -> (a
t0,[b]
a)
    in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. [(a, b)] -> (a, [b])
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (t -> t -> Bool
cmp forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)

-- | Group values at equal time points.
--
-- > let r = [(0,"a"),(1,"bc"),(2,"de"),(3,"f")]
-- > tseq_group (zip [0,1,1,2,2,3] ['a'..]) == r
--
-- > tseq_group [(1,'a'),(1,'b')] == [(1,"ab")]
-- > tseq_group [(1,'a'),(2,'b'),(2,'c')] == [(1,"a"),(2,"bc")]
tseq_group :: (Eq t,Num t) => Tseq t a -> Tseq t [a]
tseq_group :: forall t a. (Eq t, Num t) => Tseq t a -> Tseq t [a]
tseq_group = forall t a.
(Eq t, Num t) =>
(t -> t -> Bool) -> [(t, a)] -> [(t, [a])]
group_f forall a. Eq a => a -> a -> Bool
(==)

-- | Group values where the inter-offset time is @0@ to the left.
--
-- > let r = [(0,"a"),(1,"bcd"),(1,"ef")]
-- > iseq_group (zip [0,1,0,0,1,0] ['a'..]) == r
iseq_group :: (Eq t,Num t) => Iseq t a -> Iseq t [a]
iseq_group :: forall t a. (Eq t, Num t) => Tseq t a -> Tseq t [a]
iseq_group = forall t a.
(Eq t, Num t) =>
(t -> t -> Bool) -> [(t, a)] -> [(t, [a])]
group_f (\t
_ t
d -> t
d forall a. Eq a => a -> a -> Bool
== t
0)

-- * Fill

-- | Set durations so that there are no gaps or overlaps.
--   For entries with the same start time this leads to zero durations.
--
-- > let r = wseq_zip [0,3,3,5] [3,0,2,1] "abcd"
-- > wseq_fill_dur (wseq_zip [0,3,3,5] [2,1,2,1] "abcd") == r
wseq_fill_dur :: Num t => Wseq t a -> Wseq t a
wseq_fill_dur :: forall t a. Num t => Wseq t a -> Wseq t a
wseq_fill_dur Wseq t a
l =
    let f :: (((b, b), b), ((b, b), b)) -> ((b, b), b)
f (((b
t1,b
_),b
e),((b
t2,b
_),b
_)) = ((b
t1,b
t2forall a. Num a => a -> a -> a
-b
t1),b
e)
    in forall a b. (a -> b) -> [a] -> [b]
map forall {b} {b} {b} {b} {b}.
Num b =>
(((b, b), b), ((b, b), b)) -> ((b, b), b)
f (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
1 Wseq t a
l) forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last Wseq t a
l]

-- * Dseq

dseq_lcm :: Dseq Rational e -> Integer
dseq_lcm :: forall e. Dseq Rational e -> Integer
dseq_lcm = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Integral a => a -> a -> a
lcm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ratio a -> a
denominator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | Scale by lcm so that all durations are integral.
dseq_set_whole :: [Dseq Rational e] -> [Dseq Integer e]
dseq_set_whole :: forall e. [Dseq Rational e] -> [Dseq Integer e]
dseq_set_whole [Dseq Rational e]
sq =
    let m :: Integer
m = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall e. Dseq Rational e -> Integer
dseq_lcm [Dseq Rational e]
sq)
        t_f :: Ratio a -> a
t_f Ratio a
n = forall a. Integral a => Ratio a -> a
T.rational_whole_err (Ratio a
n forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m)
    in forall a b. (a -> b) -> [a] -> [b]
map (forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
dseq_tmap forall a. Integral a => Ratio a -> a
t_f) [Dseq Rational e]
sq

-- | End-time of sequence (ie. sum of durations).
dseq_end :: Num t => Dseq t a -> t
dseq_end :: forall t a. Num t => Dseq t a -> t
dseq_end = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

-- * Tseq

-- | Given a a default value, a 'Tseq' /sq/ and a list of time-points
-- /t/, generate a Tseq that is a union of the timepoints at /sq/ and
-- /t/ where times in /t/ not at /sq/ are given the /current/ value,
-- or /def/ if there is no value.
--
-- > tseq_latch 'a' [(2,'b'),(4,'c')] [1..5] == zip [1..5] "abbcc"
tseq_latch :: Ord t => a -> Tseq t a -> [t] -> Tseq t a
tseq_latch :: forall t a. Ord t => a -> Tseq t a -> [t] -> Tseq t a
tseq_latch a
def Tseq t a
sq [t]
t =
    case (Tseq t a
sq,[t]
t) of
      ([],[t]
_) -> forall a b. [a] -> [b] -> [(a, b)]
zip [t]
t (forall a. a -> [a]
repeat a
def)
      (Tseq t a
_,[]) -> []
      ((t
sq_t,a
sq_e):Tseq t a
sq',t
t0:[t]
t') -> case forall a. Ord a => a -> a -> Ordering
compare t
sq_t t
t0 of
                                   Ordering
LT -> (t
sq_t,a
sq_e) forall a. a -> [a] -> [a]
: forall t a. Ord t => a -> Tseq t a -> [t] -> Tseq t a
tseq_latch a
sq_e Tseq t a
sq' [t]
t
                                   Ordering
EQ -> (t
sq_t,a
sq_e) forall a. a -> [a] -> [a]
: forall t a. Ord t => a -> Tseq t a -> [t] -> Tseq t a
tseq_latch a
sq_e Tseq t a
sq' [t]
t'
                                   Ordering
GT -> (t
t0,a
def) forall a. a -> [a] -> [a]
: forall t a. Ord t => a -> Tseq t a -> [t] -> Tseq t a
tseq_latch a
def Tseq t a
sq [t]
t'

-- | End-time of sequence (ie. time of last event).
tseq_end :: Tseq t a -> t
tseq_end :: forall t a. Tseq t a -> t
tseq_end = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last

-- | Append the value /nil/ at /n/ seconds after the end of the sequence.
tseq_add_nil_after :: Num t => a -> t -> Tseq t a -> Tseq t a
tseq_add_nil_after :: forall t a. Num t => a -> t -> Tseq t a -> Tseq t a
tseq_add_nil_after a
nil t
n Tseq t a
sq = Tseq t a
sq forall a. [a] -> [a] -> [a]
++ [(forall t a. Tseq t a -> t
tseq_end Tseq t a
sq forall a. Num a => a -> a -> a
+ t
n,a
nil)]

-- * Wseq

-- | Sort 'Wseq' by start time, 'Wseq' ought never to be out of
-- order.
--
-- > wseq_sort [((3,1),'a'),((1,3),'b')] == [((1,3),'b'),((3,1),'a')]
wseq_sort :: Ord t => Wseq t a -> Wseq t a
wseq_sort :: forall t a. Ord t => Wseq t a -> Wseq t a
wseq_sort = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst))

-- | Transform 'Wseq' to 'Tseq' by discarding durations.
wseq_discard_dur :: Wseq t a -> Tseq t a
wseq_discard_dur :: forall t a. Wseq t a -> Tseq t a
wseq_discard_dur = let f :: ((a, b), b) -> (a, b)
f ((a
t,b
_),b
e) = (a
t,b
e) in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {b}. ((a, b), b) -> (a, b)
f

-- | Are /e/ equal and do nodes overlap?
--   Nodes are ascending, and so overlap if:
--   1. they begin at the same time and the first has non-zero duration, or
--   2. the second begins before the first ends.
wseq_nodes_overlap :: (Ord t,Num t) => (e -> e -> Bool) -> ((t,t),e) -> ((t,t),e) -> Bool
wseq_nodes_overlap :: forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> ((t, t), e) -> ((t, t), e) -> Bool
wseq_nodes_overlap e -> e -> Bool
eq_f ((t
t1,t
d1),e
a1) ((t
t2,t
_d2),e
a2) =
  e -> e -> Bool
eq_f e
a1 e
a2 Bool -> Bool -> Bool
&& ((t
t1 forall a. Eq a => a -> a -> Bool
== t
t2 Bool -> Bool -> Bool
&& t
d1 forall a. Ord a => a -> a -> Bool
> t
0) Bool -> Bool -> Bool
|| (t
t2 forall a. Ord a => a -> a -> Bool
< (t
t1 forall a. Num a => a -> a -> a
+ t
d1)))

-- | Find first node at /sq/ that overlaps with /e0/, if there is one.
--   Note: this could, but does not, halt early, ie. when t2 > (t1 + d1).
wseq_find_overlap_1 :: (Ord t,Num t) => (e -> e -> Bool) -> ((t,t),e) -> Wseq t e -> Bool
wseq_find_overlap_1 :: forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> ((t, t), e) -> Wseq t e -> Bool
wseq_find_overlap_1 e -> e -> Bool
eq_f ((t, t), e)
e0 = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> ((t, t), e) -> ((t, t), e) -> Bool
wseq_nodes_overlap e -> e -> Bool
eq_f ((t, t), e)
e0)

-- | Determine if sequence has any overlapping equal nodes, stops after finding first instance.
--
-- > wseq_has_overlaps (==) [] == False
-- > wseq_has_overlaps (==) [((0,1),'x')]
wseq_has_overlaps :: (Ord t, Num t) => (e -> e -> Bool) -> Wseq t e -> Bool
wseq_has_overlaps :: forall t e. (Ord t, Num t) => (e -> e -> Bool) -> Wseq t e -> Bool
wseq_has_overlaps e -> e -> Bool
eq_fn =
  let recur :: [((t, t), e)] -> Bool
recur [((t, t), e)]
sq =
        case [((t, t), e)]
sq of
          [] -> Bool
False
          ((t, t), e)
e0:[((t, t), e)]
sq' -> forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> ((t, t), e) -> Wseq t e -> Bool
wseq_find_overlap_1 e -> e -> Bool
eq_fn ((t, t), e)
e0 [((t, t), e)]
sq' Bool -> Bool -> Bool
|| [((t, t), e)] -> Bool
recur [((t, t), e)]
sq'
  in forall {t}. (Ord t, Num t) => [((t, t), e)] -> Bool
recur

{- | Remove overlaps by deleting any overlapping nodes.

> let sq = [((0,1),'a'),((0,5),'a'),((1,5),'a'),((3,1),'a')]
> wseq_has_overlaps (==) sq == True
> let sq_rw = wseq_remove_overlaps_rm (==) sq
> sq_rw == [((0,1),'a'),((1,5),'a')]
> wseq_has_overlaps (==) sq_rw
-}
wseq_remove_overlaps_rm :: (Ord t,Num t) => (e -> e -> Bool) -> Wseq t e -> Wseq t e
wseq_remove_overlaps_rm :: forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> Wseq t e -> Wseq t e
wseq_remove_overlaps_rm e -> e -> Bool
eq_f =
  let recur :: [((t, t), e)] -> [((t, t), e)]
recur [((t, t), e)]
sq =
        case [((t, t), e)]
sq of
          [] -> []
          ((t, t), e)
e0:[((t, t), e)]
sq' -> ((t, t), e)
e0 forall a. a -> [a] -> [a]
: [((t, t), e)] -> [((t, t), e)]
recur (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> ((t, t), e) -> ((t, t), e) -> Bool
wseq_nodes_overlap e -> e -> Bool
eq_f ((t, t), e)
e0) [((t, t), e)]
sq')
  in forall {t}. (Ord t, Num t) => [((t, t), e)] -> [((t, t), e)]
recur

{- | Find first instance of overlap of /e/ at /sq/ and re-write durations so nodes don't overlap.
     If equal nodes begin simultaneously delete the shorter node (eithe LHS or RHS).
     If a node extends into a later node shorten the initial (LHS) duration (apply /dur_fn/ to iot).
-}
wseq_remove_overlap_rw_1 :: (Ord t,Num t) =>
                            (e -> e -> Bool) -> (t -> t) -> ((t,t),e) -> Wseq t e -> Maybe (Wseq t e)
wseq_remove_overlap_rw_1 :: forall t e.
(Ord t, Num t) =>
(e -> e -> Bool)
-> (t -> t) -> ((t, t), e) -> Wseq t e -> Maybe (Wseq t e)
wseq_remove_overlap_rw_1 e -> e -> Bool
eq_f t -> t
dur_fn ((t
t,t
d),e
a) Wseq t e
sq =
  let n_eq :: ((a, a), e) -> ((a, a), e) -> Bool
n_eq ((a
t1,a
d1),e
e1) ((a
t2,a
d2),e
e2) = a
t1 forall a. Eq a => a -> a -> Bool
== a
t2 Bool -> Bool -> Bool
&& a
d1 forall a. Eq a => a -> a -> Bool
== a
d2 Bool -> Bool -> Bool
&& e -> e -> Bool
eq_f e
e1 e
e2
  in case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> e -> Bool
eq_f e
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Wseq t e
sq of
       Maybe ((t, t), e)
Nothing -> forall a. Maybe a
Nothing
       Just ((t
t',t
d'),e
a') ->
         if t
t forall a. Eq a => a -> a -> Bool
== t
t'
         then if t
d forall a. Ord a => a -> a -> Bool
<= t
d'
         then forall a. a -> Maybe a
Just Wseq t e
sq -- delete LHS
              else forall a. a -> Maybe a
Just (((t
t,t
d),e
a) forall a. a -> [a] -> [a]
: forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy forall {a} {a}. (Eq a, Eq a) => ((a, a), e) -> ((a, a), e) -> Bool
n_eq ((t
t',t
d'),e
a') Wseq t e
sq) -- delete RHS
         else if t
t' forall a. Ord a => a -> a -> Bool
< t
t forall a. Num a => a -> a -> a
+ t
d
              then forall a. a -> Maybe a
Just (((t
t,t -> t
dur_fn (t
t' forall a. Num a => a -> a -> a
- t
t)),e
a) forall a. a -> [a] -> [a]
: Wseq t e
sq) -- truncate LHS
              else forall a. Maybe a
Nothing

{- | Run 'wseq_remove_overlap_rw_1' until sequence has no overlaps.

> let sq = [((0,1),'a'),((0,5),'a'),((1,5),'a'),((3,1),'a')]
> wseq_has_overlaps (==) sq == True
> let sq_rw = wseq_remove_overlaps_rw (==) id sq
> sq_rw == [((0,1),'a'),((1,2),'a'),((3,1),'a')]
> wseq_has_overlaps (==) sq_rw == False

> import qualified Music.Theory.Array.Csv.Midi.Mnd as T {- hmt -}
> let csv_fn = "/home/rohan/uc/the-center-is-between-us/visitants/csv/midi/air.B.1.csv"
> sq <- T.csv_midi_read_wseq csv_fn :: IO (Wseq Double (T.Event Double))
> length sq == 186
> length (wseq_remove_overlaps_rw (==) id sq) == 183
-}
wseq_remove_overlaps_rw :: (Ord t,Num t) => (e -> e -> Bool) -> (t -> t) -> Wseq t e -> Wseq t e
wseq_remove_overlaps_rw :: forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> (t -> t) -> Wseq t e -> Wseq t e
wseq_remove_overlaps_rw e -> e -> Bool
eq_f t -> t
dur_fn =
  let recur :: [((t, t), e)] -> [((t, t), e)]
recur [((t, t), e)]
sq =
        case [((t, t), e)]
sq of
          [] -> []
          ((t, t), e)
h:[((t, t), e)]
sq' ->
            case forall t e.
(Ord t, Num t) =>
(e -> e -> Bool)
-> (t -> t) -> ((t, t), e) -> Wseq t e -> Maybe (Wseq t e)
wseq_remove_overlap_rw_1 e -> e -> Bool
eq_f t -> t
dur_fn ((t, t), e)
h [((t, t), e)]
sq' of
              Maybe [((t, t), e)]
Nothing -> ((t, t), e)
h forall a. a -> [a] -> [a]
: [((t, t), e)] -> [((t, t), e)]
recur [((t, t), e)]
sq'
              Just [((t, t), e)]
sq'' -> [((t, t), e)] -> [((t, t), e)]
recur [((t, t), e)]
sq''
    in [((t, t), e)] -> [((t, t), e)]
recur

-- | Unjoin elements (assign equal time stamps to all elements).
seq_unjoin :: [(t,[e])] -> [(t,e)]
seq_unjoin :: forall t e. [(t, [e])] -> [(t, e)]
seq_unjoin = let f :: (a, [b]) -> [(a, b)]
f (a
t,[b]
e) = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat a
t) [b]
e in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {b}. (a, [b]) -> [(a, b)]
f

-- | Type specialised 'seq_unjoin'.
wseq_unjoin :: Wseq t [e] -> Wseq t e
wseq_unjoin :: forall t e. Wseq t [e] -> Wseq t e
wseq_unjoin = forall t e. [(t, [e])] -> [(t, e)]
seq_unjoin

-- | Shift (displace) onset times by /i/.
--
-- > wseq_shift 3 [((1,2),'a')] == [((4,2),'a')]
wseq_shift :: Num t => t -> Wseq t a -> Wseq t a
wseq_shift :: forall t a. Num t => t -> Wseq t a -> Wseq t a
wseq_shift t
i = forall t a. (t -> t) -> Wseq t a -> Wseq t a
wseq_tmap_st (forall a. Num a => a -> a -> a
+ t
i)

-- | Shift q to end of p and append.
--
-- > wseq_append [((1,2),'a')] [((1,2),'b')] == [((1,2),'a'),((4,2),'b')]
wseq_append :: Num t => Wseq t a -> Wseq t a -> Wseq t a
wseq_append :: forall t a. Num t => Wseq t a -> Wseq t a -> Wseq t a
wseq_append Wseq t a
p Wseq t a
q = Wseq t a
p forall a. [a] -> [a] -> [a]
++ forall t a. Num t => t -> Wseq t a -> Wseq t a
wseq_shift (forall t a. Num t => Wseq t a -> t
wseq_end Wseq t a
p) Wseq t a
q

-- | 'foldl1' of 'wseq_append'
--
-- > wseq_concat [[((1,2),'a')],[((1,2),'b')]] == [((1,2),'a'),((4,2),'b')]
wseq_concat :: Num t => [Wseq t a] -> Wseq t a
wseq_concat :: forall t a. Num t => [Wseq t a] -> Wseq t a
wseq_concat = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall t a. Num t => Wseq t a -> Wseq t a -> Wseq t a
wseq_append

-- | Transform sequence to start at time zero.
wseq_zero :: Num t => Wseq t a -> Wseq t a
wseq_zero :: forall t a. Num t => Wseq t a -> Wseq t a
wseq_zero Wseq t a
sq = let t0 :: t
t0 = forall t a. Num t => Wseq t a -> t
wseq_start Wseq t a
sq in forall t t' a. ((t, t) -> (t', t')) -> Wseq t a -> Wseq t' a
wseq_tmap (\(t
st,t
du) -> (t
st forall a. Num a => a -> a -> a
- t
t0,t
du)) Wseq t a
sq

-- * Begin/End

-- | Container to mark the /begin/ and /end/ of a value.
data Begin_End a = Begin a | End a deriving (Begin_End a -> Begin_End a -> Bool
forall a. Eq a => Begin_End a -> Begin_End a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Begin_End a -> Begin_End a -> Bool
$c/= :: forall a. Eq a => Begin_End a -> Begin_End a -> Bool
== :: Begin_End a -> Begin_End a -> Bool
$c== :: forall a. Eq a => Begin_End a -> Begin_End a -> Bool
Eq,Int -> Begin_End a -> ShowS
forall a. Show a => Int -> Begin_End a -> ShowS
forall a. Show a => [Begin_End a] -> ShowS
forall a. Show a => Begin_End a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Begin_End a] -> ShowS
$cshowList :: forall a. Show a => [Begin_End a] -> ShowS
show :: Begin_End a -> String
$cshow :: forall a. Show a => Begin_End a -> String
showsPrec :: Int -> Begin_End a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Begin_End a -> ShowS
Show)

-- | Functor instance.
begin_end_map :: (t -> u) -> Begin_End t -> Begin_End u
begin_end_map :: forall t u. (t -> u) -> Begin_End t -> Begin_End u
begin_end_map t -> u
f Begin_End t
x =
    case Begin_End t
x of
      Begin t
a -> forall a. a -> Begin_End a
Begin (t -> u
f t
a)
      End t
a -> forall a. a -> Begin_End a
End (t -> u
f t
a)

instance Functor Begin_End where fmap :: forall t u. (t -> u) -> Begin_End t -> Begin_End u
fmap = forall t u. (t -> u) -> Begin_End t -> Begin_End u
begin_end_map

-- | Structural comparison at 'Begin_End', 'Begin' compares less than 'End'.
cmp_begin_end :: Begin_End a -> Begin_End b -> Ordering
cmp_begin_end :: forall a b. Begin_End a -> Begin_End b -> Ordering
cmp_begin_end Begin_End a
p Begin_End b
q =
    case (Begin_End a
p,Begin_End b
q) of
      (Begin a
_,End b
_) -> Ordering
LT
      (Begin a
_,Begin b
_) -> Ordering
EQ
      (End a
_,End b
_) -> Ordering
EQ
      (End a
_,Begin b
_) -> Ordering
GT

--instance Eq t => Ord (Begin_End t) where compare = cmp_begin_end

-- | Translate container types.
either_to_begin_end :: Either a a -> Begin_End a
either_to_begin_end :: forall a. Either a a -> Begin_End a
either_to_begin_end Either a a
p =
    case Either a a
p of
      Left a
a -> forall a. a -> Begin_End a
Begin a
a
      Right a
a -> forall a. a -> Begin_End a
End a
a

-- | Translate container types.
begin_end_to_either :: Begin_End a -> Either a a
begin_end_to_either :: forall a. Begin_End a -> Either a a
begin_end_to_either Begin_End a
p =
    case Begin_End a
p of
      Begin a
a -> forall a b. a -> Either a b
Left a
a
      End a
a -> forall a b. b -> Either a b
Right a
a

-- | Equivalent to 'partitionEithers'.
begin_end_partition :: [Begin_End a] -> ([a],[a])
begin_end_partition :: forall a. [Begin_End a] -> ([a], [a])
begin_end_partition =
  let f :: Begin_End a -> ([a], [a]) -> ([a], [a])
f Begin_End a
e ([a]
p,[a]
q) = case Begin_End a
e of
                    Begin a
x -> (a
xforall a. a -> [a] -> [a]
:[a]
p,[a]
q)
                    End a
x -> ([a]
p,a
xforall a. a -> [a] -> [a]
:[a]
q)
  in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Begin_End a -> ([a], [a]) -> ([a], [a])
f ([],[])

-- | Add or delete element from accumulated state given equality function.
begin_end_track_by :: (a -> a -> Bool) -> [a] -> Begin_End a -> [a]
begin_end_track_by :: forall a. (a -> a -> Bool) -> [a] -> Begin_End a -> [a]
begin_end_track_by a -> a -> Bool
eq_f [a]
st Begin_End a
e =
  case Begin_End a
e of
    Begin a
x -> a
x forall a. a -> [a] -> [a]
: [a]
st
    End a
x -> forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
eq_f a
x [a]
st

-- | 'begin_end_track_by' of '=='.
begin_end_track :: Eq a => [a] -> Begin_End a -> [a]
begin_end_track :: forall a. Eq a => [a] -> Begin_End a -> [a]
begin_end_track = forall a. (a -> a -> Bool) -> [a] -> Begin_End a -> [a]
begin_end_track_by forall a. Eq a => a -> a -> Bool
(==)

{- | Convert 'Wseq' to 'Tseq' transforming elements to 'Begin_End'.
     When merging, /end/ elements precede /begin/ elements at equal times.

> let sq = [((0,5),'a'),((2,2),'b')]
> let r = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]
> wseq_begin_end sq == r

> let sq = [((0,1),'a'),((1,1),'b'),((2,1),'c')]
> let r = [(0,Begin 'a'),(1,End 'a'),(1,Begin 'b'),(2,End 'b'),(2,Begin 'c'),(3,End 'c')]
> wseq_begin_end sq == r
-}
wseq_begin_end :: (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
wseq_begin_end :: forall t a. (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
wseq_begin_end Wseq t a
sq =
    let f :: ((a, a), a) -> [(a, Begin_End a)]
f ((a
t,a
d),a
a) = [(a
t,forall a. a -> Begin_End a
Begin a
a),(a
t forall a. Num a => a -> a -> a
+ a
d,forall a. a -> Begin_End a
End a
a)]
        g :: [Tseq t (Begin_End a)] -> Tseq t (Begin_End a)
g [Tseq t (Begin_End a)]
l =
            case [Tseq t (Begin_End a)]
l of
              [] -> []
              Tseq t (Begin_End a)
e:[Tseq t (Begin_End a)]
l' -> forall t a.
Ord t =>
Compare_F a -> Tseq t a -> Tseq t a -> Tseq t a
tseq_merge_by (\Begin_End a
x -> Ordering -> Ordering
T.ord_invert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Begin_End a -> Begin_End b -> Ordering
cmp_begin_end Begin_End a
x) Tseq t (Begin_End a)
e ([Tseq t (Begin_End a)] -> Tseq t (Begin_End a)
g [Tseq t (Begin_End a)]
l')
    in forall {t} {a}.
Ord t =>
[Tseq t (Begin_End a)] -> Tseq t (Begin_End a)
g (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. Num a => ((a, a), a) -> [(a, Begin_End a)]
f Wseq t a
sq)

-- | 'begin_end_to_either' of 'wseq_begin_end'.
wseq_begin_end_either :: (Num t, Ord t) => Wseq t a -> Tseq t (Either a a)
wseq_begin_end_either :: forall t a. (Num t, Ord t) => Wseq t a -> Tseq t (Either a a)
wseq_begin_end_either = forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
tseq_map forall a. Begin_End a -> Either a a
begin_end_to_either forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
wseq_begin_end

-- | Variant that applies /begin/ and /end/ functions to nodes.
--
-- > let sq = [((0,5),'a'),((2,2),'b')]
-- > let r = [(0,'A'),(2,'B'),(4,'b'),(5,'a')]
-- > wseq_begin_end_f Data.Char.toUpper id sq == r
wseq_begin_end_f :: (Ord t,Num t) => (a -> b) -> (a -> b) -> Wseq t a -> Tseq t b
wseq_begin_end_f :: forall t a b.
(Ord t, Num t) =>
(a -> b) -> (a -> b) -> Wseq t a -> Tseq t b
wseq_begin_end_f a -> b
f a -> b
g = forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
tseq_map (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> b
f a -> b
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (Num t, Ord t) => Wseq t a -> Tseq t (Either a a)
wseq_begin_end_either

-- | Generate for each time-point the triple (begin-list,end-list,hold-list).
--   The elements of the end-list have been deleted from the hold list.
tseq_begin_end_accum :: Eq a => Tseq t [Begin_End a] -> Tseq t ([a],[a],[a])
tseq_begin_end_accum :: forall a t. Eq a => Tseq t [Begin_End a] -> Tseq t ([a], [a], [a])
tseq_begin_end_accum =
  let f :: [a] -> (a, [Begin_End a]) -> ([a], (a, ([a], [a], [a])))
f [a]
st (a
t,[Begin_End a]
x) =
            let ([a]
b,[a]
e) = forall a. [Begin_End a] -> ([a], [a])
begin_end_partition [Begin_End a]
x
                st' :: [a]
st' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Eq a => [a] -> Begin_End a -> [a]
begin_end_track [a]
st [Begin_End a]
x
            in ([a]
st',(a
t,([a]
b,[a]
e,[a]
st forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
e)))
    in forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a} {a}.
Eq a =>
[a] -> (a, [Begin_End a]) -> ([a], (a, ([a], [a], [a])))
f []

-- | Variant that initially transforms 'Wseq' into non-overlapping begin-end sequence.
--   If the sequence was edited for overlaps this is indicated.
wseq_begin_end_accum :: (Eq e, Ord t, Num t) => Wseq t e -> (Bool, Tseq t ([e],[e],[e]))
wseq_begin_end_accum :: forall e t.
(Eq e, Ord t, Num t) =>
Wseq t e -> (Bool, Tseq t ([e], [e], [e]))
wseq_begin_end_accum Wseq t e
sq =
  let ol :: Bool
ol = forall t e. (Ord t, Num t) => (e -> e -> Bool) -> Wseq t e -> Bool
wseq_has_overlaps forall a. Eq a => a -> a -> Bool
(==) Wseq t e
sq
      sq_edit :: Wseq t e
sq_edit = if Bool
ol then forall t e.
(Ord t, Num t) =>
(e -> e -> Bool) -> (t -> t) -> Wseq t e -> Wseq t e
wseq_remove_overlaps_rw forall a. Eq a => a -> a -> Bool
(==) forall a. a -> a
id Wseq t e
sq else Wseq t e
sq
      a_sq :: Tseq t ([e], [e], [e])
a_sq = forall a t. Eq a => Tseq t [Begin_End a] -> Tseq t ([a], [a], [a])
tseq_begin_end_accum (forall t a. (Eq t, Num t) => Tseq t a -> Tseq t [a]
tseq_group (forall t a. (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
wseq_begin_end Wseq t e
sq_edit))
  in (Bool
ol,Tseq t ([e], [e], [e])
a_sq)

tseq_accumulate :: Eq a => Tseq t [Begin_End a] -> Tseq t [a]
tseq_accumulate :: forall a t. Eq a => Tseq t [Begin_End a] -> Tseq t [a]
tseq_accumulate =
  let f :: [a] -> (a, t (Begin_End a)) -> ([a], (a, [a]))
f [a]
st (a
t,t (Begin_End a)
e) =
            let g :: b -> (b, (a, b))
g b
st' = (b
st',(a
t,b
st'))
            in forall {b}. b -> (b, (a, b))
g (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Eq a => [a] -> Begin_End a -> [a]
begin_end_track [a]
st t (Begin_End a)
e)
    in forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {t :: * -> *} {a} {a}.
(Foldable t, Eq a) =>
[a] -> (a, t (Begin_End a)) -> ([a], (a, [a]))
f []

-- | The transition sequence of /active/ elements.
--
-- > let w = [((0,3),'a'),((1,2),'b'),((2,1),'c'),((3,3),'d')]
-- > wseq_accumulate w == [(0,"a"),(1,"ba"),(2,"cba"),(3,"d"),(6,"")]
wseq_accumulate :: (Eq a,Ord t,Num t) => Wseq t a -> Tseq t [a]
wseq_accumulate :: forall a t. (Eq a, Ord t, Num t) => Wseq t a -> Tseq t [a]
wseq_accumulate = forall a t. Eq a => Tseq t [Begin_End a] -> Tseq t [a]
tseq_accumulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (Eq t, Num t) => Tseq t a -> Tseq t [a]
tseq_group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
wseq_begin_end

-- | Inverse of 'wseq_begin_end' given a predicate function for locating
-- the /end/ node of a /begin/ node.
--
-- > let sq = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]
-- > let r = [((0,5),'a'),((2,2),'b')]
-- > tseq_begin_end_to_wseq (==) sq == r
tseq_begin_end_to_wseq :: Num t => (a -> a -> Bool) -> Tseq t (Begin_End a) -> Wseq t a
tseq_begin_end_to_wseq :: forall t a.
Num t =>
(a -> a -> Bool) -> Tseq t (Begin_End a) -> Wseq t a
tseq_begin_end_to_wseq a -> a -> Bool
cmp =
    let cmp' :: a -> Begin_End a -> Bool
cmp' a
x Begin_End a
e =
            case Begin_End a
e of
              End a
x' -> a -> a -> Bool
cmp a
x a
x'
              Begin_End a
_ -> Bool
False
        f :: a -> [(a, Begin_End a)] -> a
f a
e [(a, Begin_End a)]
r = case forall e t. (e -> Bool) -> [(t, e)] -> Maybe (t, e)
seq_find (a -> Begin_End a -> Bool
cmp' a
e) [(a, Begin_End a)]
r of
                        Maybe (a, Begin_End a)
Nothing -> forall a. HasCallStack => String -> a
error String
"tseq_begin_end_to_wseq: no matching end?"
                        Just (a
t,Begin_End a
_) -> a
t
        go :: [(b, Begin_End a)] -> [((b, b), a)]
go [(b, Begin_End a)]
sq = case [(b, Begin_End a)]
sq of
                  [] -> []
                  (b
_,End a
_) : [(b, Begin_End a)]
sq' -> [(b, Begin_End a)] -> [((b, b), a)]
go [(b, Begin_End a)]
sq'
                  (b
t,Begin a
e) : [(b, Begin_End a)]
sq' -> let t' :: b
t' = forall {a}. a -> [(a, Begin_End a)] -> a
f a
e [(b, Begin_End a)]
sq' in ((b
t,b
t' forall a. Num a => a -> a -> a
- b
t),a
e) forall a. a -> [a] -> [a]
: [(b, Begin_End a)] -> [((b, b), a)]
go [(b, Begin_End a)]
sq'
    in forall {b}. Num b => [(b, Begin_End a)] -> [((b, b), a)]
go

-- * Interop

useq_to_dseq :: Useq t a -> Dseq t a
useq_to_dseq :: forall {a} {b}. (a, [b]) -> [(a, b)]
useq_to_dseq (t
t,[a]
e) = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat t
t) [a]
e

useq_to_wseq :: Num t => t -> Useq t a -> Wseq t a
useq_to_wseq :: forall t a. Num t => t -> Useq t a -> Wseq t a
useq_to_wseq t
t0 = forall t a. Num t => t -> Dseq t a -> Wseq t a
dseq_to_wseq t
t0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. (a, [b]) -> [(a, b)]
useq_to_dseq

-- | The conversion requires a start time and a /nil/ value used as an
-- /eof/ marker. Productive given indefinite input sequence.
--
-- > let r = zip [0,1,3,6,8,9] "abcde|"
-- > dseq_to_tseq 0 '|' (zip [1,2,3,2,1] "abcde") == r
--
-- > let d = zip [1,2,3,2,1] "abcde"
-- > let r = zip [0,1,3,6,8,9,10] "abcdeab"
-- > take 7 (dseq_to_tseq 0 undefined (cycle d)) == r
dseq_to_tseq :: Num t => t -> a -> Dseq t a -> Tseq t a
dseq_to_tseq :: forall t a. Num t => t -> a -> Dseq t a -> Dseq t a
dseq_to_tseq t
t0 a
nil = forall t u v w.
([t] -> [u]) -> ([v] -> [w]) -> [(t, v)] -> [(u, w)]
T.rezip (forall a. Num a => a -> [a] -> [a]
T.dx_d t
t0) (forall a. a -> [a] -> [a]
T.snoc a
nil)

-- | Variant where the /nil/ value is taken from the last element of
-- the sequence.
--
-- > let r = zip [0,1,3,6,8,9] "abcdee"
-- > dseq_to_tseq_last 0 (zip [1,2,3,2,1] "abcde") == r
dseq_to_tseq_last :: Num t => t -> Dseq t a -> Tseq t a
dseq_to_tseq_last :: forall t a. Num t => t -> Dseq t a -> Dseq t a
dseq_to_tseq_last t
t0 Dseq t a
sq = forall t a. Num t => t -> a -> Dseq t a -> Dseq t a
dseq_to_tseq t
t0 (forall a b. (a, b) -> b
snd (forall a. [a] -> a
last Dseq t a
sq)) Dseq t a
sq

{- | Variant where the final duration is discarded.

> dseq_to_tseq_discard 0 (zip [1,2,3,2,1] "abcde") == zip [0,1,3,6,8] "abcde"
-}
dseq_to_tseq_discard :: Num t => t -> Dseq t a -> Tseq t a
dseq_to_tseq_discard :: forall t a. Num t => t -> Dseq t a -> Dseq t a
dseq_to_tseq_discard t
t0 = forall a. [a] -> [a]
T.drop_last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => t -> a -> Dseq t a -> Dseq t a
dseq_to_tseq t
t0 forall a. HasCallStack => a
undefined

-- | 'Iseq' to 'Tseq', requires t0.
--
-- > let r = zip [1,3,6,8,9] "abcde"
-- > iseq_to_tseq 0 (zip [1,2,3,2,1] "abcde") == r
iseq_to_tseq :: Num t => t -> Iseq t a -> Tseq t a
iseq_to_tseq :: forall t a. Num t => t -> Dseq t a -> Dseq t a
iseq_to_tseq t
t0 = forall t u v w.
([t] -> [u]) -> ([v] -> [w]) -> [(t, v)] -> [(u, w)]
T.rezip (forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> [a] -> [a]
T.dx_d t
t0) forall a. a -> a
id

-- | The conversion requires a start time and does not consult the
-- /logical/ duration.
--
-- > let p = pseq_zip (repeat undefined) (cycle [1,2]) (cycle [1,1,2]) "abcdef"
-- > pseq_to_wseq 0 p == wseq_zip [0,1,2,4,5,6] (cycle [1,2]) "abcdef"
pseq_to_wseq :: Num t => t -> Pseq t a -> Wseq t a
pseq_to_wseq :: forall t a. Num t => t -> Pseq t a -> Wseq t a
pseq_to_wseq t
t0 Pseq t a
sq =
    let ([(t, t, t)]
p,[a]
a) = forall a b. [(a, b)] -> ([a], [b])
unzip Pseq t a
sq
        ([t]
_,[t]
d,[t]
f) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(t, t, t)]
p
        t :: [t]
t = forall a. Num a => a -> [a] -> [a]
T.dx_d t
t0 [t]
f
    in forall t a. [t] -> [t] -> [a] -> Wseq t a
wseq_zip [t]
t [t]
d [a]
a

-- | The last element of 'Tseq' is required to be an /eof/ marker that
-- has no duration and is not represented in the 'Dseq'.  A 'nil'
-- value is required in case the 'Tseq' does not begin at @0@.
--
-- > let r = zip [1,2,3,2,1] "abcde"
-- > tseq_to_dseq undefined (zip [0,1,3,6,8,9] "abcde|") == r
--
-- > let r = zip [1,2,3,2,1] "-abcd"
-- > tseq_to_dseq '-' (zip [1,3,6,8,9] "abcd|") == r
tseq_to_dseq :: (Ord t,Num t) => a -> Tseq t a -> Dseq t a
tseq_to_dseq :: forall t a. (Ord t, Num t) => a -> Tseq t a -> Tseq t a
tseq_to_dseq a
empty Tseq t a
sq =
    let ([t]
t,[a]
a) = forall a b. [(a, b)] -> ([a], [b])
unzip Tseq t a
sq
        d :: [t]
d = forall a. Num a => [a] -> [a]
T.d_dx [t]
t
    in case [t]
t of
         [] -> []
         t
t0:[t]
_ -> if t
t0 forall a. Ord a => a -> a -> Bool
> t
0 then (t
t0,a
empty) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip [t]
d [a]
a else forall a b. [a] -> [b] -> [(a, b)]
zip [t]
d [a]
a

{- | Variant that requires a final duration be provided, and that the Tseq have no end marker.

> let r = zip [1,2,3,2,9] "abcde"
> tseq_to_dseq_final_dur undefined 9 (zip [0,1,3,6,8] "abcde") == r
-}
tseq_to_dseq_final_dur :: (Ord t,Num t) => a -> t -> Tseq t a -> Dseq t a
tseq_to_dseq_final_dur :: forall t a. (Ord t, Num t) => a -> t -> Tseq t a -> Tseq t a
tseq_to_dseq_final_dur a
empty t
dur Tseq t a
sq =
  let ([t]
t,[a]
a) = forall a b. [(a, b)] -> ([a], [b])
unzip Tseq t a
sq
      d :: [t]
d = forall a. Num a => [a] -> [a]
T.d_dx [t]
t forall a. [a] -> [a] -> [a]
++ [t
dur]
  in case [t]
t of
       [] -> []
       t
t0:[t]
_ -> if t
t0 forall a. Ord a => a -> a -> Bool
> t
0 then (t
t0,a
empty) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip [t]
d [a]
a else forall a b. [a] -> [b] -> [(a, b)]
zip [t]
d [a]
a

{- | Variant that requires a total duration be provided, and that the Tseq have no end marker.

> let r = zip [1,2,3,2,7] "abcde"
> tseq_to_dseq_total_dur undefined 15 (zip [0,1,3,6,8] "abcde")
-}
tseq_to_dseq_total_dur :: (Ord t,Num t) => a -> t -> Tseq t a -> Dseq t a
tseq_to_dseq_total_dur :: forall t a. (Ord t, Num t) => a -> t -> Tseq t a -> Tseq t a
tseq_to_dseq_total_dur a
empty t
dur Tseq t a
sq = forall t a. (Ord t, Num t) => a -> t -> Tseq t a -> Tseq t a
tseq_to_dseq_final_dur a
empty (t
dur forall a. Num a => a -> a -> a
- forall t a. Tseq t a -> t
tseq_end Tseq t a
sq) Tseq t a
sq

-- | The last element of 'Tseq' is required to be an /eof/ marker that
-- has no duration and is not represented in the 'Wseq'.  The duration
-- of each value is either derived from the value, if a /dur/
-- function is given, or else the inter-offset time.
--
-- > let r = wseq_zip [0,1,3,6,8] [1,2,3,2,1] "abcde"
-- > tseq_to_wseq Nothing (zip [0,1,3,6,8,9] "abcde|") == r
--
-- > let r = wseq_zip [0,1,3,6,8] (map fromEnum "abcde") "abcde"
-- > tseq_to_wseq (Just fromEnum) (zip [0,1,3,6,8,9] "abcde|") == r
tseq_to_wseq :: Num t => Maybe (a -> t) -> Tseq t a -> Wseq t a
tseq_to_wseq :: forall t a. Num t => Maybe (a -> t) -> Tseq t a -> Wseq t a
tseq_to_wseq Maybe (a -> t)
dur_f Tseq t a
sq =
    let ([t]
t,[a]
a) = forall a b. [(a, b)] -> ([a], [b])
unzip Tseq t a
sq
        d :: [t]
d = case Maybe (a -> t)
dur_f of
              Just a -> t
f -> forall a b. (a -> b) -> [a] -> [b]
map a -> t
f (forall a b. (a, b) -> a
fst (forall a. [a] -> ([a], a)
T.separate_last [a]
a))
              Maybe (a -> t)
Nothing -> forall a. Num a => [a] -> [a]
T.d_dx [t]
t
    in forall t a. [t] -> [t] -> [a] -> Wseq t a
wseq_zip [t]
t [t]
d [a]
a

{- | Translate Tseq to Wseq using inter-offset times, up to indicated total duration, as element durations.

> let r = [((0,1),'a'),((1,2),'b'),((3,3),'c'),((6,2),'d'),((8,3),'e')]
> tseq_to_wseq_iot 11 (zip [0,1,3,6,8] "abcde") == r
-}
tseq_to_wseq_iot :: Num t => t -> Tseq t a -> Wseq t a
tseq_to_wseq_iot :: forall t a. Num t => t -> Dseq t a -> Wseq t a
tseq_to_wseq_iot t
total_dur Tseq t a
sq =
  let ([t]
t, [a]
e) = forall a b. [(a, b)] -> ([a], [b])
unzip Tseq t a
sq
      d :: [t]
d = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall a. [a] -> [a]
tail [t]
t forall a. [a] -> [a] -> [a]
++ [t
total_dur]) [t]
t
  in forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> [(a, b)]
zip [t]
t [t]
d) [a]
e

-- | Tseq to Iseq.
--
-- > tseq_to_iseq (zip [0,1,3,6,8,9] "abcde|") == zip [0,1,2,3,2,1] "abcde|"
tseq_to_iseq :: Num t => Tseq t a -> Iseq t a
tseq_to_iseq :: forall t a. Num t => Tseq t a -> Tseq t a
tseq_to_iseq =
    let recur :: t -> [(t, b)] -> [(t, b)]
recur t
n [(t, b)]
p =
            case [(t, b)]
p of
              [] -> []
              (t
t,b
e):[(t, b)]
p' -> (t
t forall a. Num a => a -> a -> a
- t
n,b
e) forall a. a -> [a] -> [a]
: t -> [(t, b)] -> [(t, b)]
recur t
t [(t, b)]
p'
    in forall t a. Num t => t -> Dseq t a -> Dseq t a
recur t
0

-- | Requires start time.
--
-- > let r = zip (zip [0,1,3,6,8,9] [1,2,3,2,1]) "abcde"
-- > dseq_to_wseq 0 (zip [1,2,3,2,1] "abcde") == r
dseq_to_wseq :: Num t => t -> Dseq t a -> Wseq t a
dseq_to_wseq :: forall t a. Num t => t -> Dseq t a -> Wseq t a
dseq_to_wseq t
t0 Dseq t a
sq =
    let ([t]
d,[a]
a) = forall a b. [(a, b)] -> ([a], [b])
unzip Dseq t a
sq
        t :: [t]
t = forall a. Num a => a -> [a] -> [a]
T.dx_d t
t0 [t]
d
    in forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> [(a, b)]
zip [t]
t [t]
d) [a]
a

-- | Inverse of 'dseq_to_wseq'.  The /empty/ value is used to fill
-- holes in 'Wseq'.  If values overlap at 'Wseq' durations are
-- truncated.
--
-- > let w = wseq_zip [0,1,3,6,8,9] [1,2,3,2,1] "abcde"
-- > wseq_to_dseq '-' w == zip [1,2,3,2,1] "abcde"
--
-- > let w = wseq_zip [3,10] [6,2] "ab"
-- > wseq_to_dseq '-' w == zip [3,6,1,2] "-a-b"
--
-- > let w = wseq_zip [0,1] [2,2] "ab"
-- > wseq_to_dseq '-' w == zip [1,2] "ab"
--
-- > let w = wseq_zip [0,0,0] [2,2,2] "abc"
-- > wseq_to_dseq '-' w == zip [0,0,2] "abc"
wseq_to_dseq :: (Num t,Ord t) => a -> Wseq t a -> Dseq t a
wseq_to_dseq :: forall t a. (Num t, Ord t) => a -> Wseq t a -> Dseq t a
wseq_to_dseq a
empty Wseq t a
sq =
    let f :: (((a, a), a), ((a, b), b)) -> [(a, a)]
f (((a
st0,a
d),a
e),((a
st1,b
_),b
_)) =
            let d' :: a
d' = a
st1 forall a. Num a => a -> a -> a
- a
st0
            in case forall a. Ord a => a -> a -> Ordering
compare a
d a
d' of
                 Ordering
LT -> [(a
d,a
e),(a
d'forall a. Num a => a -> a -> a
-a
d,a
empty)]
                 Ordering
EQ -> [(a
d,a
e)]
                 Ordering
GT -> [(a
d',a
e)]
        ((t
_,t
dN),a
eN) = forall a. [a] -> a
last Wseq t a
sq
        r :: [(t, a)]
r = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {b} {b}.
(Ord a, Num a) =>
(((a, a), a), ((a, b), b)) -> [(a, a)]
f (forall t. Int -> [t] -> [(t, t)]
T.adj2 Int
1 Wseq t a
sq) forall a. [a] -> [a] -> [a]
++ [(t
dN,a
eN)]
    in case Wseq t a
sq of
         ((t
st,t
_),a
_):Wseq t a
_ -> if t
st forall a. Ord a => a -> a -> Bool
> t
0 then (t
st,a
empty) forall a. a -> [a] -> [a]
: [(t, a)]
r else [(t, a)]
r
         [] -> forall a. HasCallStack => String -> a
error String
"wseq_to_dseq"

eseq_to_wseq :: Eseq t a -> Wseq t a
eseq_to_wseq :: forall t a. Eseq t a -> Wseq t a
eseq_to_wseq = let f :: ((a, b, c), b) -> ((a, b), b)
f ((a
t, b
d, c
_), b
e) = ((a
t, b
d), b
e) in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {b}. ((a, b, c), b) -> ((a, b), b)
f

-- * Measures

-- | Given a list of 'Dseq' (measures) convert to a list of 'Tseq' and
-- the end time of the overall sequence.
--
-- > let r = [[(0,'a'),(1,'b'),(3,'c')],[(4,'d'),(7,'e'),(9,'f')]]
-- > dseql_to_tseql 0 [zip [1,2,1] "abc",zip [3,2,1] "def"] == (10,r)
dseql_to_tseql :: Num t => t -> [Dseq t a] -> (t,[Tseq t a])
dseql_to_tseql :: forall t a. Num t => t -> [Dseq t a] -> (t, [Dseq t a])
dseql_to_tseql =
    let f :: a -> [(a, b)] -> (a, [(a, b)])
f a
z [(a, b)]
dv =
            let ([a]
tm,[b]
el) = forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
dv
                (a
z',[a]
r) = forall t. Num t => t -> [t] -> (t, [t])
T.dx_d' a
z [a]
tm
            in (a
z',forall a b. [a] -> [b] -> [(a, b)]
zip [a]
r [b]
el)
    in forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a} {b}. Num a => a -> [(a, b)] -> (a, [(a, b)])
f

-- * Cycle

-- | List of cycles of 'Wseq'.
wseq_cycle_ls :: Num t => Wseq t a -> [Wseq t a]
wseq_cycle_ls :: forall t a. Num t => Wseq t a -> [Wseq t a]
wseq_cycle_ls Wseq t a
sq =
    let (t
_,t
et) = forall t a. Num t => Wseq t a -> (t, t)
wseq_tspan Wseq t a
sq
        t_sq :: [t]
t_sq = forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+ t
et) t
0
    in forall a b. (a -> b) -> [a] -> [b]
map (\t
x -> forall t t' a. ((t, t) -> (t', t')) -> Wseq t a -> Wseq t' a
wseq_tmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Num a => a -> a -> a
+ t
x)) Wseq t a
sq) [t]
t_sq

-- | Only finite 'Wseq' can be cycled, the resulting Wseq is infinite.
--
-- > take 5 (wseq_cycle [((0,1),'a'),((3,3),'b')])
wseq_cycle :: Num t => Wseq t a -> Wseq t a
wseq_cycle :: forall t a. Num t => Wseq t a -> Wseq t a
wseq_cycle = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Wseq t a -> [Wseq t a]
wseq_cycle_ls

-- | Variant cycling only /n/ times.
--
-- > wseq_cycle_n 3 [((0,1),'a'),((3,3),'b')]
wseq_cycle_n :: Num t => Int -> Wseq t a -> Wseq t a
wseq_cycle_n :: forall t a. Num t => Int -> Wseq t a -> Wseq t a
wseq_cycle_n Int
n = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Wseq t a -> [Wseq t a]
wseq_cycle_ls

-- | 'wseq_until' of 'wseq_cycle'.
wseq_cycle_until :: (Num t,Ord t) => t -> Wseq t a -> Wseq t a
wseq_cycle_until :: forall t a. (Num t, Ord t) => t -> Wseq t a -> Wseq t a
wseq_cycle_until t
et = forall t a. Ord t => t -> Wseq t a -> Wseq t a
wseq_until t
et forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => Wseq t a -> Wseq t a
wseq_cycle

-- * Type specialised maps

dseq_tmap :: (t -> t') -> Dseq t a -> Dseq t' a
dseq_tmap :: forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
dseq_tmap = forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap

pseq_tmap :: ((t,t,t) -> (t',t',t')) -> Pseq t a -> Pseq t' a
pseq_tmap :: forall t t' a. ((t, t, t) -> (t', t', t')) -> Pseq t a -> Pseq t' a
pseq_tmap = forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap

tseq_tmap :: (t -> t') -> Dseq t a -> Dseq t' a
tseq_tmap :: forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
tseq_tmap = forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap

tseq_bimap :: (t -> t') -> (e -> e') -> Tseq t e -> Tseq t' e'
tseq_bimap :: forall t1 t2 e1 e2.
(t1 -> t2) -> (e1 -> e2) -> [(t1, e1)] -> [(t2, e2)]
tseq_bimap = forall t1 t2 e1 e2.
(t1 -> t2) -> (e1 -> e2) -> [(t1, e1)] -> [(t2, e2)]
seq_bimap

wseq_tmap :: ((t,t) -> (t',t')) -> Wseq t a -> Wseq t' a
wseq_tmap :: forall t t' a. ((t, t) -> (t', t')) -> Wseq t a -> Wseq t' a
wseq_tmap = forall t1 t2 a. (t1 -> t2) -> [(t1, a)] -> [(t2, a)]
seq_tmap

dseq_map :: (a -> b) -> Dseq t a -> Dseq t b
dseq_map :: forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
dseq_map = forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
seq_map

pseq_map :: (a -> b) -> Pseq t a -> Pseq t b
pseq_map :: forall a b t. (a -> b) -> Pseq t a -> Pseq t b
pseq_map = forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
seq_map

tseq_map :: (a -> b) -> Tseq t a -> Tseq t b
tseq_map :: forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
tseq_map = forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
seq_map

wseq_map :: (a -> b) -> Wseq t a -> Wseq t b
wseq_map :: forall a b t. (a -> b) -> Wseq t a -> Wseq t b
wseq_map = forall e1 e2 t. (e1 -> e2) -> [(t, e1)] -> [(t, e2)]
seq_map

-- * Type specialised filter

dseq_tfilter :: (t -> Bool) -> Dseq t a -> Dseq t a
dseq_tfilter :: forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
dseq_tfilter = forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_tfilter

iseq_tfilter :: (t -> Bool) -> Iseq t a -> Iseq t a
iseq_tfilter :: forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
iseq_tfilter = forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_tfilter

pseq_tfilter :: ((t,t,t) -> Bool) -> Pseq t a -> Pseq t a
pseq_tfilter :: forall t a. ((t, t, t) -> Bool) -> Pseq t a -> Pseq t a
pseq_tfilter = forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_tfilter

tseq_tfilter :: (t -> Bool) -> Tseq t a -> Tseq t a
tseq_tfilter :: forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
tseq_tfilter = forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_tfilter

wseq_tfilter :: ((t,t) -> Bool) -> Wseq t a -> Wseq t a
wseq_tfilter :: forall t a. ((t, t) -> Bool) -> Wseq t a -> Wseq t a
wseq_tfilter = forall t a. (t -> Bool) -> [(t, a)] -> [(t, a)]
seq_tfilter

dseq_filter :: (a -> Bool) -> Dseq t a -> Dseq t a
dseq_filter :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
dseq_filter = forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_filter

iseq_filter :: (a -> Bool) -> Iseq t a -> Iseq t a
iseq_filter :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
iseq_filter = forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_filter

pseq_filter :: (a -> Bool) -> Pseq t a -> Pseq t a
pseq_filter :: forall a t. (a -> Bool) -> Pseq t a -> Pseq t a
pseq_filter = forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_filter

tseq_filter :: (a -> Bool) -> Tseq t a -> Tseq t a
tseq_filter :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
tseq_filter = forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_filter

wseq_filter :: (a -> Bool) -> Wseq t a -> Wseq t a
wseq_filter :: forall a t. (a -> Bool) -> Wseq t a -> Wseq t a
wseq_filter = forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
seq_filter

-- * Type specialised maybe

wseq_map_maybe :: (a -> Maybe b) -> Wseq t a -> Wseq t b
wseq_map_maybe :: forall a b t. (a -> Maybe b) -> Wseq t a -> Wseq t b
wseq_map_maybe = forall p q t. (p -> Maybe q) -> [(t, p)] -> [(t, q)]
seq_map_maybe

wseq_cat_maybes :: Wseq t (Maybe a) -> Wseq t a
wseq_cat_maybes :: forall t a. Wseq t (Maybe a) -> Wseq t a
wseq_cat_maybes = forall t q. [(t, Maybe q)] -> [(t, q)]
seq_cat_maybes

-- * Maps

{- | Requires but does not check that there are no duplicate time points in Tseq.

> tseq_to_map [(0, 'a'), (0, 'b')] == tseq_to_map [(0, 'b')]
-}
tseq_to_map :: Ord t => Tseq t e -> Map.Map t e
tseq_to_map :: forall t e. Ord t => Tseq t e -> Map t e
tseq_to_map = forall t e. Ord t => Tseq t e -> Map t e
Map.fromList