{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.Generic.Control (
constant,
linear,
linearMultiscale,
linearMultiscaleNeutral,
line,
exponential, exponentialMultiscale,
exponentialMultiscaleNeutral,
exponential2, exponential2Multiscale,
exponential2MultiscaleNeutral,
vectorExponential,
vectorExponential2,
cosine, cosineMultiscaleLinear,
cosineMultiscale,
Ctrl.cosineWithSlope,
cubicHermite,
) where
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.Generic.Signal as SigG
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field as Field
import qualified Algebra.Additive as Additive
import qualified Number.Complex as Complex
import Number.Complex (cis,real)
import NumericPrelude.Numeric
import NumericPrelude.Base
constant :: (SigG.Write sig y) =>
SigG.LazySize -> y -> sig y
constant :: forall (sig :: * -> *) y. Write sig y => LazySize -> y -> sig y
constant = LazySize -> y -> sig y
forall y. Storage (sig y) => LazySize -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> y -> sig y
SigG.repeat
linear :: (Additive.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> y
-> sig y
linear :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
linear LazySize
size y
d y
y0 = LazySize -> (y -> y) -> y -> sig y
forall y. Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y) -> y -> sig y
SigG.iterate LazySize
size (y
dy -> y -> y
forall a. C a => a -> a -> a
+) y
y0
linearMultiscale ::
(Additive.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> y
-> sig y
linearMultiscale :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
linearMultiscale LazySize
size =
LazySize -> (y -> y -> y) -> y -> y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscale LazySize
size y -> y -> y
forall a. C a => a -> a -> a
(+)
linearMultiscaleNeutral :: (Additive.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> sig y
linearMultiscaleNeutral :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> sig y
linearMultiscaleNeutral LazySize
size y
slope =
LazySize -> (y -> y -> y) -> y -> y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscaleNeutral LazySize
size y -> y -> y
forall a. C a => a -> a -> a
(+) y
slope y
forall a. C a => a
zero
line :: (Field.C y, SigG.Write sig y) =>
SigG.LazySize
-> Int
-> (y,y)
-> sig y
line :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> Int -> (y, y) -> sig y
line LazySize
size Int
n (y
y0,y
y1) =
Int -> sig y -> sig y
forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ LazySize -> y -> y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
linear LazySize
size ((y
y1y -> y -> y
forall a. C a => a -> a -> a
-y
y0) y -> y -> y
forall a. C a => a -> a -> a
/ Int -> y
forall a b. (C a, C b) => a -> b
fromIntegral Int
n) y
y0
exponential, exponentialMultiscale ::
(Trans.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> y
-> sig y
exponential :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
exponential LazySize
size y
time =
LazySize -> (y -> y) -> y -> sig y
forall y. Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y) -> y -> sig y
SigG.iterate LazySize
size (y -> y -> y
forall a. C a => a -> a -> a
* y -> y
forall a. C a => a -> a
exp (- y -> y
forall a. C a => a -> a
recip y
time))
exponentialMultiscale :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
exponentialMultiscale LazySize
size y
time =
LazySize -> (y -> y -> y) -> y -> y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscale LazySize
size y -> y -> y
forall a. C a => a -> a -> a
(*) (y -> y
forall a. C a => a -> a
exp (- y -> y
forall a. C a => a -> a
recip y
time))
exponentialMultiscaleNeutral :: (Trans.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> sig y
exponentialMultiscaleNeutral :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> sig y
exponentialMultiscaleNeutral LazySize
size y
time =
LazySize -> (y -> y -> y) -> y -> y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscaleNeutral LazySize
size y -> y -> y
forall a. C a => a -> a -> a
(*) (y -> y
forall a. C a => a -> a
exp (- y -> y
forall a. C a => a -> a
recip y
time)) y
forall a. C a => a
one
exponential2, exponential2Multiscale :: (Trans.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> y
-> sig y
exponential2 :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
exponential2 LazySize
size y
halfLife =
LazySize -> (y -> y) -> y -> sig y
forall y. Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y) -> y -> sig y
SigG.iterate LazySize
size (y -> y -> y
forall a. C a => a -> a -> a
* y
0.5 y -> y -> y
forall a. C a => a -> a -> a
** y -> y
forall a. C a => a -> a
recip y
halfLife)
exponential2Multiscale :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
exponential2Multiscale LazySize
size y
halfLife =
LazySize -> (y -> y -> y) -> y -> y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscale LazySize
size y -> y -> y
forall a. C a => a -> a -> a
(*) (y
0.5 y -> y -> y
forall a. C a => a -> a -> a
** y -> y
forall a. C a => a -> a
recip y
halfLife)
exponential2MultiscaleNeutral :: (Trans.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> sig y
exponential2MultiscaleNeutral :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> sig y
exponential2MultiscaleNeutral LazySize
size y
halfLife =
LazySize -> (y -> y -> y) -> y -> y -> sig y
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscaleNeutral LazySize
size y -> y -> y
forall a. C a => a -> a -> a
(*) (y
0.5 y -> y -> y
forall a. C a => a -> a -> a
** y -> y
forall a. C a => a -> a
recip y
halfLife) y
forall a. C a => a
one
vectorExponential ::
(Trans.C y, Module.C y v, SigG.Write sig v) =>
SigG.LazySize
-> y
-> v
-> sig v
vectorExponential :: forall y v (sig :: * -> *).
(C y, C y v, Write sig v) =>
LazySize -> y -> v -> sig v
vectorExponential LazySize
size y
time v
y0 =
LazySize -> (v -> v) -> v -> sig v
forall y. Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y) -> y -> sig y
SigG.iterate LazySize
size (y -> y
forall a. C a => a -> a
exp (-y
1y -> y -> y
forall a. C a => a -> a -> a
/y
time) y -> v -> v
forall a v. C a v => a -> v -> v
*>) v
y0
vectorExponential2 ::
(Trans.C y, Module.C y v, SigG.Write sig v) =>
SigG.LazySize
-> y
-> v
-> sig v
vectorExponential2 :: forall y v (sig :: * -> *).
(C y, C y v, Write sig v) =>
LazySize -> y -> v -> sig v
vectorExponential2 LazySize
size y
halfLife v
y0 =
LazySize -> (v -> v) -> v -> sig v
forall y. Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y) -> y -> sig y
SigG.iterate LazySize
size (y
0.5y -> y -> y
forall a. C a => a -> a -> a
**(y
1y -> y -> y
forall a. C a => a -> a -> a
/y
halfLife) y -> v -> v
forall a v. C a v => a -> v -> v
*>) v
y0
cosine, cosineMultiscaleLinear :: (Trans.C y, SigG.Write sig y) =>
SigG.LazySize
-> y
-> y
-> sig y
cosine :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
cosine LazySize
size = (y -> y -> sig y) -> y -> y -> sig y
forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
Ctrl.cosineWithSlope ((y -> y -> sig y) -> y -> y -> sig y)
-> (y -> y -> sig y) -> y -> y -> sig y
forall a b. (a -> b) -> a -> b
$
\y
d y
x -> (y -> y) -> sig y -> sig y
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map y -> y
forall a. C a => a -> a
cos (LazySize -> y -> y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
linear LazySize
size y
d y
x)
cosineMultiscaleLinear :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
cosineMultiscaleLinear LazySize
size = (y -> y -> sig y) -> y -> y -> sig y
forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
Ctrl.cosineWithSlope ((y -> y -> sig y) -> y -> y -> sig y)
-> (y -> y -> sig y) -> y -> y -> sig y
forall a b. (a -> b) -> a -> b
$
\y
d y
x -> (y -> y) -> sig y -> sig y
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map y -> y
forall a. C a => a -> a
cos (LazySize -> y -> y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
linearMultiscale LazySize
size y
d y
x)
cosineMultiscale ::
(Trans.C y, SigG.Write sig (Complex.T y),
SigG.Transform sig (Complex.T y), SigG.Transform sig y) =>
SigG.LazySize
-> y
-> y
-> sig y
cosineMultiscale :: forall y (sig :: * -> *).
(C y, Write sig (T y), Transform sig (T y), Transform sig y) =>
LazySize -> y -> y -> sig y
cosineMultiscale LazySize
size = (y -> y -> sig y) -> y -> y -> sig y
forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
Ctrl.cosineWithSlope ((y -> y -> sig y) -> y -> y -> sig y)
-> (y -> y -> sig y) -> y -> y -> sig y
forall a b. (a -> b) -> a -> b
$
\y
d y
x -> (T y -> y) -> sig (T y) -> sig y
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map T y -> y
forall a. T a -> a
real (LazySize -> (T y -> T y -> T y) -> T y -> T y -> sig (T y)
forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscale LazySize
size T y -> T y -> T y
forall a. C a => a -> a -> a
(*) (y -> T y
forall a. C a => a -> T a
cis y
d) (y -> T y
forall a. C a => a -> T a
cis y
x))
cubicHermite :: (Field.C y, SigG.Write sig y) =>
SigG.LazySize
-> (y, (y,y)) -> (y, (y,y)) -> sig y
cubicHermite :: forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> (y, (y, y)) -> (y, (y, y)) -> sig y
cubicHermite LazySize
size (y, (y, y))
node0 (y, (y, y))
node1 =
(y -> y) -> sig y -> sig y
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map ((y, (y, y)) -> (y, (y, y)) -> y -> y
forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (y, (y, y))
node0 (y, (y, y))
node1) (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ LazySize -> y -> y -> sig y
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
linear LazySize
size y
1 y
0
curveMultiscale :: (SigG.Write sig y) =>
SigG.LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscale :: forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscale LazySize
size y -> y -> y
op y
d y
y0 =
y -> sig y -> sig y
forall y. Storage (sig y) => y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
SigG.cons y
y0 (sig y -> sig y) -> (sig y -> sig y) -> sig y -> sig y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> y) -> sig y -> sig y
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (y -> y -> y
op y
y0) (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ LazySize -> (y -> y -> y) -> y -> sig y
forall y.
Storage (sig y) =>
LazySize -> (y -> y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y -> y) -> y -> sig y
SigG.iterateAssociative LazySize
size y -> y -> y
op y
d
curveMultiscaleNeutral :: (SigG.Write sig y) =>
SigG.LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscaleNeutral :: forall (sig :: * -> *) y.
Write sig y =>
LazySize -> (y -> y -> y) -> y -> y -> sig y
curveMultiscaleNeutral LazySize
size y -> y -> y
op y
d y
neutral =
y -> sig y -> sig y
forall y. Storage (sig y) => y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
SigG.cons y
neutral (sig y -> sig y) -> sig y -> sig y
forall a b. (a -> b) -> a -> b
$ LazySize -> (y -> y -> y) -> y -> sig y
forall y.
Storage (sig y) =>
LazySize -> (y -> y -> y) -> y -> sig y
forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> (y -> y -> y) -> y -> sig y
SigG.iterateAssociative LazySize
size y -> y -> y
op y
d