{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.PiecewiseConstant.Signal (
T,
StrictTime,
ShortStrictTime,
LazyTime,
subdivideLazy,
subdivideLazyToShort,
subdivideLongStrict,
chopLongTime,
longFromShortTime,
zipWith,
) where
import Synthesizer.PiecewiseConstant.Private
(StrictTime, ShortStrictTime, chopLongTime)
import qualified Data.EventList.Relative.TimeTime as EventListTT
import qualified Data.EventList.Relative.MixedTime as EventListMT
import qualified Data.EventList.Relative.BodyTime as EventListBT
import qualified Numeric.NonNegative.Class as NonNeg
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import Numeric.NonNegative.Class ((-|), )
import Control.Monad.Trans.State (evalState, get, put, )
import Data.Traversable (traverse, )
import qualified Data.List as List
import Data.Maybe.HT (toMaybe, )
import NumericPrelude.Numeric
import NumericPrelude.Base hiding (zipWith, )
import qualified Prelude as P
type LazyTime = NonNegChunky.T StrictTime
type T = EventListBT.T StrictTime
{-# INLINE subdivideLazy #-}
subdivideLazy ::
(NonNeg.C time) =>
EventListBT.T (NonNegChunky.T time) body ->
EventListBT.T time body
subdivideLazy :: forall time body. C time => T (T time) body -> T time body
subdivideLazy =
forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
(\body
y T time
lt T time body
r ->
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr
(\time
dt ->
forall body time. body -> T time body -> T time body
EventListMT.consBody body
y forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall time body. time -> T time body -> T time body
EventListMT.consTime time
dt) T time body
r forall a b. (a -> b) -> a -> b
$
forall a. T a -> [a]
NonNegChunky.toChunks (forall a. C a => T a -> T a
NonNegChunky.normalize T time
lt))
forall time body. T time body
EventListBT.empty
{-# INLINE subdivideLazyToShort #-}
subdivideLazyToShort ::
EventListBT.T LazyTime y -> EventListBT.T ShortStrictTime y
subdivideLazyToShort :: forall y. T LazyTime y -> T ShortStrictTime y
subdivideLazyToShort =
forall time body. C time => T (T time) body -> T time body
subdivideLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventListBT.mapTime
(forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap StrictTime -> [ShortStrictTime]
chopLongTime forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. T a -> [a]
NonNegChunky.toChunks)
{-# INLINE longFromShortTime #-}
longFromShortTime :: ShortStrictTime -> StrictTime
longFromShortTime :: ShortStrictTime -> StrictTime
longFromShortTime =
forall a. (Ord a, Num a) => String -> a -> T a
NonNegW.fromNumberMsg String
"longFromShortTime" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (C a, C b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. T a -> a
NonNegW.toNumber
{-# INLINE subdivideLongStrict #-}
subdivideLongStrict ::
EventListBT.T StrictTime y -> EventListBT.T ShortStrictTime y
subdivideLongStrict :: forall y. T StrictTime y -> T ShortStrictTime y
subdivideLongStrict =
forall time body. C time => T (T time) body -> T time body
subdivideLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventListBT.mapTime
(forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTime -> [ShortStrictTime]
chopLongTime)
_subdivideMaybe ::
EventListBT.T LazyTime y -> EventListBT.T StrictTime (Maybe y)
_subdivideMaybe :: forall y. T LazyTime y -> T StrictTime (Maybe y)
_subdivideMaybe =
forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
(\y
y LazyTime
lt T StrictTime (Maybe y)
r ->
case forall a. T a -> [a]
NonNegChunky.toChunks (forall a. C a => T a -> T a
NonNegChunky.normalize LazyTime
lt) of
[] -> T StrictTime (Maybe y)
r
(StrictTime
t:[StrictTime]
ts) ->
forall body time. body -> time -> T time body -> T time body
EventListBT.cons (forall a. a -> Maybe a
Just y
y) StrictTime
t forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (forall body time. body -> time -> T time body -> T time body
EventListBT.cons forall a. Maybe a
Nothing) T StrictTime (Maybe y)
r [StrictTime]
ts)
forall time body. T time body
EventListBT.empty
{-# INLINE subdivideMaybe #-}
subdivideMaybe ::
EventListTT.T LazyTime y ->
EventListTT.T StrictTime (Maybe y)
subdivideMaybe :: forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe =
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
EventListTT.foldr
(\LazyTime
lt T StrictTime (Maybe y)
r ->
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall time body. time -> T time body -> T time body
EventListMT.consTime forall a b. (a -> b) -> a -> b
$
case forall a. T a -> [a]
NonNegChunky.toChunks (forall a. C a => T a -> T a
NonNegChunky.normalize LazyTime
lt) of
[] ->
(forall a. (Ord a, Num a) => a -> T a
NonNegW.fromNumber forall a. C a => a
zero, T StrictTime (Maybe y)
r)
(StrictTime
t:[StrictTime]
ts) ->
(StrictTime
t, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (forall body time. body -> time -> T time body -> T time body
EventListBT.cons forall a. Maybe a
Nothing) T StrictTime (Maybe y)
r [StrictTime]
ts))
(\y
y T StrictTime (Maybe y)
r -> forall body time. body -> T time body -> T time body
EventListMT.consBody (forall a. a -> Maybe a
Just y
y) T StrictTime (Maybe y)
r)
forall time body. T time body
EventListBT.empty
{-# INLINE unionMaybe #-}
unionMaybe ::
EventListTT.T StrictTime (Maybe y) ->
EventListTT.T LazyTime y
unionMaybe :: forall y. T StrictTime (Maybe y) -> T LazyTime y
unionMaybe =
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
EventListTT.foldr
(\StrictTime
t ->
forall time body. (time -> time) -> T time body -> T time body
EventListMT.mapTimeHead
(forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictTime
tforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> [a]
NonNegChunky.toChunks))
(\Maybe y
my ->
case Maybe y
my of
Maybe y
Nothing -> forall a. a -> a
id
Just y
y ->
forall time body. time -> T time body -> T time body
EventListMT.consTime forall a. T a
NonNegChunky.zero forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall body time. body -> T time body -> T time body
EventListMT.consBody y
y)
(forall time body. time -> T time body
EventListTT.pause forall a. T a
NonNegChunky.zero)
zipWithCore ::
(NonNeg.C time) =>
(a -> b -> c) ->
a -> b ->
EventListTT.T time (Maybe a) ->
EventListTT.T time (Maybe b) ->
EventListTT.T time (Maybe c)
zipWithCore :: forall time a b c.
C time =>
(a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
zipWithCore a -> b -> c
f =
let switch :: b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch b
ac T time (Maybe b)
ar (Bool, b) -> T time (Maybe b) -> T time body
g =
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T time (Maybe b)
ar forall a b. (a -> b) -> a -> b
$ \Maybe b
am T time (Maybe b)
ar1 ->
(Bool, b) -> T time (Maybe b) -> T time body
g (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,b
ac) ((,) Bool
True) Maybe b
am) T time (Maybe b)
ar1
cont :: Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont Bool
j a
ac b
bc T time (Maybe a)
as T time (Maybe b)
bs =
forall body time. body -> T time body -> T time body
EventListMT.consBody (forall a. Bool -> a -> Maybe a
toMaybe Bool
j forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
ac b
bc) forall a b. (a -> b) -> a -> b
$
a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
recourse a
ac b
bc T time (Maybe a)
as T time (Maybe b)
bs
recourse :: a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
recourse a
ac b
bc T time (Maybe a)
as T time (Maybe b)
bs =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL T time (Maybe a)
as forall a b. (a -> b) -> a -> b
$ \time
at T time (Maybe a)
ar ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall time body a. (time -> T time body -> a) -> T time body -> a
EventListMT.switchTimeL T time (Maybe b)
bs forall a b. (a -> b) -> a -> b
$ \time
bt T time (Maybe b)
br ->
let ct :: time
ct = forall a. Ord a => a -> a -> a
min time
at time
bt
in
forall time body. time -> T time body -> T time body
EventListMT.consTime time
ct forall a b. (a -> b) -> a -> b
$
case forall a. Ord a => a -> a -> Ordering
compare time
at time
bt of
Ordering
LT ->
forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch a
ac T time (Maybe a)
ar forall a b. (a -> b) -> a -> b
$ \(Bool
ab,a
a) T time (Maybe a)
ar1 ->
Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont Bool
ab a
a b
bc T time (Maybe a)
ar1 (forall time body. time -> T time body -> T time body
EventListMT.consTime (time
btforall a. C a => a -> a -> a
-|time
ct) T time (Maybe b)
br)
Ordering
GT ->
forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch b
bc T time (Maybe b)
br forall a b. (a -> b) -> a -> b
$ \(Bool
bb,b
b) T time (Maybe b)
br1 ->
Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont Bool
bb a
ac b
b (forall time body. time -> T time body -> T time body
EventListMT.consTime (time
atforall a. C a => a -> a -> a
-|time
ct) T time (Maybe a)
ar) T time (Maybe b)
br1
Ordering
EQ ->
forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch a
ac T time (Maybe a)
ar forall a b. (a -> b) -> a -> b
$ \(Bool
ab,a
a) T time (Maybe a)
ar1 ->
forall {b} {time} {time} {body}.
b
-> T time (Maybe b)
-> ((Bool, b) -> T time (Maybe b) -> T time body)
-> T time body
switch b
bc T time (Maybe b)
br forall a b. (a -> b) -> a -> b
$ \(Bool
bb,b
b) T time (Maybe b)
br1 ->
Bool
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
cont (Bool
abBool -> Bool -> Bool
||Bool
bb) a
a b
b T time (Maybe a)
ar1 T time (Maybe b)
br1
in forall {time}.
C time =>
a -> b -> T time (Maybe a) -> T time (Maybe b) -> T time (Maybe c)
recourse
zipWith ::
(NonNeg.C time) =>
(a -> b -> c) ->
EventListBT.T time a ->
EventListBT.T time b ->
EventListBT.T time c
zipWith :: forall time a b c.
C time =>
(a -> b -> c) -> T time a -> T time b -> T time c
zipWith a -> b -> c
f T time a
as0 T time b
bs0 =
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T time a
as0 forall a b. (a -> b) -> a -> b
$ \a
a0 T time a
as1 ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T time b
bs0 forall a b. (a -> b) -> a -> b
$ \b
b0 T time b
bs1 ->
let c0 :: c
c0 = a -> b -> c
f a
a0 b
b0
in forall body time. body -> T time body -> T time body
EventListMT.consBody c
c0 forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState c
c0 forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Maybe c
mc -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Maybe c
mc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => StateT s m s
get) forall a b. (a -> b) -> a -> b
$
forall time a b c.
C time =>
(a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
zipWithCore a -> b -> c
f a
a0 b
b0 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just T time a
as1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just T time b
bs1)
_zipWithLazy ::
(a -> b -> c) ->
EventListBT.T LazyTime a ->
EventListBT.T LazyTime b ->
EventListBT.T LazyTime c
_zipWithLazy :: forall a b c.
(a -> b -> c) -> T LazyTime a -> T LazyTime b -> T LazyTime c
_zipWithLazy a -> b -> c
f T LazyTime a
as0 T LazyTime b
bs0 =
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T LazyTime a
as0 forall a b. (a -> b) -> a -> b
$ \a
a0 T LazyTime a
as1 ->
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a body time.
a -> (body -> T time body -> a) -> T time body -> a
EventListMT.switchBodyL forall time body. T time body
EventListBT.empty) T LazyTime b
bs0 forall a b. (a -> b) -> a -> b
$ \b
b0 T LazyTime b
bs1 ->
forall body time. body -> T time body -> T time body
EventListMT.consBody (a -> b -> c
f a
a0 b
b0) forall a b. (a -> b) -> a -> b
$ forall y. T StrictTime (Maybe y) -> T LazyTime y
unionMaybe forall a b. (a -> b) -> a -> b
$
forall time a b c.
C time =>
(a -> b -> c)
-> a
-> b
-> T time (Maybe a)
-> T time (Maybe b)
-> T time (Maybe c)
zipWithCore a -> b -> c
f a
a0 b
b0 (forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe T LazyTime a
as1) (forall y. T LazyTime y -> T StrictTime (Maybe y)
subdivideMaybe T LazyTime b
bs1)