{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.State.Control (
constant,
line,
linear, linearMultiscale, linearMultiscaleNeutral,
exponential, exponentialMultiscale, exponentialMultiscaleNeutral,
exponential2, exponential2Multiscale, exponential2MultiscaleNeutral,
exponentialFromTo, exponentialFromToMultiscale,
vectorExponential,
vectorExponential2,
cosine,
cubicHermite,
curveMultiscale,
curveMultiscaleNeutral,
) where
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.State.Signal as Sig
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE constant #-}
constant :: a -> Sig.T a
constant :: forall a. a -> T a
constant = a -> T a
forall a. a -> T a
Sig.repeat
{-# INLINE linear #-}
linear :: Additive.C a =>
a
-> a
-> Sig.T a
linear :: forall a. C a => a -> a -> T a
linear a
d a
y0 = (a -> a) -> a -> T a
forall a. (a -> a) -> a -> T a
Sig.iterate (a
da -> a -> a
forall a. C a => a -> a -> a
+) a
y0
{-# INLINE linearMultiscale #-}
linearMultiscale :: Additive.C y =>
y
-> y
-> Sig.T y
linearMultiscale :: forall a. C a => a -> a -> T a
linearMultiscale = (y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale y -> y -> y
forall a. C a => a -> a -> a
(+)
{-# INLINE linearMultiscaleNeutral #-}
linearMultiscaleNeutral :: Additive.C y =>
y
-> Sig.T y
linearMultiscaleNeutral :: forall y. C y => y -> T y
linearMultiscaleNeutral y
slope =
(y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral y -> y -> y
forall a. C a => a -> a -> a
(+) y
slope y
forall a. C a => a
zero
{-# INLINE line #-}
line :: Field.C y =>
Int
-> (y,y)
-> Sig.T y
line :: forall y. C y => Int -> (y, y) -> T y
line Int
n (y
y0,y
y1) =
Int -> T y -> T y
forall a. Int -> T a -> T a
Sig.take Int
n (T y -> T y) -> T y -> T y
forall a b. (a -> b) -> a -> b
$ y -> y -> T y
forall a. C a => a -> a -> T a
linear ((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
{-# INLINE exponential #-}
{-# INLINE exponentialMultiscale #-}
exponential, exponentialMultiscale :: Trans.C a =>
a
-> a
-> Sig.T a
exponential :: forall a. C a => a -> a -> T a
exponential a
time =
(a -> a) -> a -> T a
forall a. (a -> a) -> a -> T a
Sig.iterate (a -> a
forall a. C a => a -> a
exp (- a -> a
forall a. C a => a -> a
recip a
time) a -> a -> a
forall a. C a => a -> a -> a
*)
exponentialMultiscale :: forall a. C a => a -> a -> T a
exponentialMultiscale a
time = (a -> a -> a) -> a -> a -> T a
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale a -> a -> a
forall a. C a => a -> a -> a
(*) (a -> a
forall a. C a => a -> a
exp (- a -> a
forall a. C a => a -> a
recip a
time))
{-# INLINE exponentialMultiscaleNeutral #-}
exponentialMultiscaleNeutral :: Trans.C y =>
y
-> Sig.T y
exponentialMultiscaleNeutral :: forall y. C y => y -> T y
exponentialMultiscaleNeutral y
time =
(y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral 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
{-# INLINE exponential2 #-}
{-# INLINE exponential2Multiscale #-}
exponential2, exponential2Multiscale :: Trans.C a =>
a
-> a
-> Sig.T a
exponential2 :: forall a. C a => a -> a -> T a
exponential2 a
halfLife =
(a -> a) -> a -> T a
forall a. (a -> a) -> a -> T a
Sig.iterate (((a
forall a. C a => a
Ring.onea -> a -> a
forall a. C a => a -> a -> a
+a
forall a. C a => a
Ring.one) a -> a -> a
forall a. C a => a -> a -> a
** (- a -> a
forall a. C a => a -> a
recip a
halfLife)) a -> a -> a
forall a. C a => a -> a -> a
*)
exponential2Multiscale :: forall a. C a => a -> a -> T a
exponential2Multiscale a
halfLife = (a -> a -> a) -> a -> a -> T a
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale a -> a -> a
forall a. C a => a -> a -> a
(*) (a
0.5 a -> a -> a
forall a. C a => a -> a -> a
** a -> a
forall a. C a => a -> a
recip a
halfLife)
{-# INLINE exponential2MultiscaleNeutral #-}
exponential2MultiscaleNeutral :: Trans.C y =>
y
-> Sig.T y
exponential2MultiscaleNeutral :: forall y. C y => y -> T y
exponential2MultiscaleNeutral y
halfLife =
(y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral 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
{-# INLINE exponentialFromTo #-}
{-# INLINE exponentialFromToMultiscale #-}
exponentialFromTo, exponentialFromToMultiscale :: Trans.C y =>
y
-> y
-> y
-> Sig.T y
exponentialFromTo :: forall y. C y => y -> y -> y -> T y
exponentialFromTo y
time y
y0 y
y1 =
(y -> y) -> y -> T y
forall a. (a -> a) -> a -> T a
Sig.iterate (y -> y -> y
forall a. C a => a -> a -> a
* (y
y1y -> y -> y
forall a. C a => a -> a -> a
/y
y0) y -> y -> y
forall a. C a => a -> a -> a
** y -> y
forall a. C a => a -> a
recip y
time) y
y0
exponentialFromToMultiscale :: forall y. C y => y -> y -> y -> T y
exponentialFromToMultiscale y
time y
y0 y
y1 =
(y -> y -> y) -> y -> y -> T y
forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale y -> y -> y
forall a. C a => a -> a -> a
(*) ((y
y1y -> y -> y
forall a. C a => a -> a -> a
/y
y0) y -> y -> y
forall a. C a => a -> a -> a
** y -> y
forall a. C a => a -> a
recip y
time) y
y0
{-# INLINE vectorExponential #-}
vectorExponential :: (Trans.C a, Module.C a v) =>
a
-> v
-> Sig.T v
vectorExponential :: forall a v. (C a, C a v) => a -> v -> T v
vectorExponential a
time v
y0 =
(v -> v) -> v -> T v
forall a. (a -> a) -> a -> T a
Sig.iterate (a -> a
forall a. C a => a -> a
exp (-a
1a -> a -> a
forall a. C a => a -> a -> a
/a
time) a -> v -> v
forall a v. C a v => a -> v -> v
*>) v
y0
{-# INLINE vectorExponential2 #-}
vectorExponential2 :: (Trans.C a, Module.C a v) =>
a
-> v
-> Sig.T v
vectorExponential2 :: forall a v. (C a, C a v) => a -> v -> T v
vectorExponential2 a
halfLife v
y0 =
(v -> v) -> v -> T v
forall a. (a -> a) -> a -> T a
Sig.iterate (a
0.5a -> a -> a
forall a. C a => a -> a -> a
**(a
1a -> a -> a
forall a. C a => a -> a -> a
/a
halfLife) a -> v -> v
forall a v. C a v => a -> v -> v
*>) v
y0
{-# INLINE cosine #-}
cosine :: Trans.C a =>
a
-> a
-> Sig.T a
cosine :: forall a. C a => a -> a -> T a
cosine = (a -> a -> T a) -> a -> a -> T a
forall y signal. C y => (y -> y -> signal) -> y -> y -> signal
Ctrl.cosineWithSlope ((a -> a -> T a) -> a -> a -> T a)
-> (a -> a -> T a) -> a -> a -> T a
forall a b. (a -> b) -> a -> b
$
\a
d a
x -> (a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
Sig.map a -> a
forall a. C a => a -> a
cos (a -> a -> T a
forall a. C a => a -> a -> T a
linear a
d a
x)
{-# INLINE cubicHermite #-}
cubicHermite :: Field.C a => (a, (a,a)) -> (a, (a,a)) -> Sig.T a
cubicHermite :: forall a. C a => (a, (a, a)) -> (a, (a, a)) -> T a
cubicHermite (a, (a, a))
node0 (a, (a, a))
node1 =
(a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
Sig.map ((a, (a, a)) -> (a, (a, a)) -> a -> a
forall y. C y => (y, (y, y)) -> (y, (y, y)) -> y -> y
Ctrl.cubicFunc (a, (a, a))
node0 (a, (a, a))
node1) (a -> a -> T a
forall a. C a => a -> a -> T a
linear a
1 a
0)
{-# INLINE curveMultiscale #-}
curveMultiscale :: (y -> y -> y) -> y -> y -> Sig.T y
curveMultiscale :: forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscale y -> y -> y
op y
d y
y0 =
y -> T y -> T y
forall a. a -> T a -> T a
Sig.cons y
y0 ((y -> y) -> T y -> T y
forall a b. (a -> b) -> T a -> T b
Sig.map (y -> y -> y
op y
y0) ((y -> y -> y) -> y -> T y
forall a. (a -> a -> a) -> a -> T a
Sig.iterateAssociative y -> y -> y
op y
d))
{-# INLINE curveMultiscaleNeutral #-}
curveMultiscaleNeutral :: (y -> y -> y) -> y -> y -> Sig.T y
curveMultiscaleNeutral :: forall y. (y -> y -> y) -> y -> y -> T y
curveMultiscaleNeutral y -> y -> y
op y
d y
neutral =
y -> T y -> T y
forall a. a -> T a -> T a
Sig.cons y
neutral ((y -> y -> y) -> y -> T y
forall a. (a -> a -> a) -> a -> T a
Sig.iterateAssociative y -> y -> y
op y
d)