{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.State.Filter.NonRecursive (
amplify,
amplifyVector,
envelope,
envelopeVector,
fadeInOut,
generic,
binomial,
binomial1,
sums,
inverseFrequencyModulationFloor,
inverseFrequencyModulationCeiling,
differentiate,
differentiateCenter,
differentiate2,
) where
import Synthesizer.Basic.Filter.NonRecursive (ratioFreqToVariance, )
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.State.Filter.Delay as Delay
import qualified Synthesizer.State.Control as Ctrl
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import Data.Function.HT (nest, )
import Data.Tuple.HT (mapFst, )
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE amplify #-}
amplify :: (Ring.C a) => a -> Sig.T a -> Sig.T a
amplify :: forall a. C a => a -> T a -> T a
amplify a
v = (a -> a) -> T a -> T a
forall a b. (a -> b) -> T a -> T b
Sig.map (a
va -> a -> a
forall a. C a => a -> a -> a
*)
{-# INLINE amplifyVector #-}
amplifyVector :: (Module.C a v) => a -> Sig.T v -> Sig.T v
amplifyVector :: forall a v. C a v => a -> T v -> T v
amplifyVector a
v = (v -> v) -> T v -> T v
forall a b. (a -> b) -> T a -> T b
Sig.map (a
va -> v -> v
forall a v. C a v => a -> v -> v
*>)
{-# INLINE envelope #-}
envelope :: (Ring.C a) =>
Sig.T a
-> Sig.T a
-> Sig.T a
envelope :: forall a. C a => T a -> T a -> T a
envelope = (a -> a -> a) -> T a -> T a -> T a
forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith a -> a -> a
forall a. C a => a -> a -> a
(*)
{-# INLINE envelopeVector #-}
envelopeVector :: (Module.C a v) =>
Sig.T a
-> Sig.T v
-> Sig.T v
envelopeVector :: forall a v. C a v => T a -> T v -> T v
envelopeVector = (a -> v -> v) -> T a -> T v -> T v
forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith a -> v -> v
forall a v. C a v => a -> v -> v
(*>)
{-# INLINE fadeInOut #-}
fadeInOut :: (Field.C a) =>
Int -> Int -> Int -> Sig.T a -> Sig.T a
fadeInOut :: forall a. C a => Int -> Int -> Int -> T a -> T a
fadeInOut Int
tIn Int
tHold Int
tOut =
let leadIn :: T a
leadIn = Int -> T a -> T a
forall a. Int -> T a -> T a
Sig.take Int
tIn (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.linear ( a -> a
forall a. C a => a -> a
recip (Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
tIn)) a
forall a. C a => a
zero
leadOut :: T a
leadOut = Int -> T a -> T a
forall a. Int -> T a -> T a
Sig.take Int
tOut (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ a -> a -> T a
forall a. C a => a -> a -> T a
Ctrl.linear (- a -> a
forall a. C a => a -> a
recip (Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
tOut)) a
forall a. C a => a
one
hold :: T a
hold = Int -> a -> T a
forall a. Int -> a -> T a
Sig.replicate Int
tHold a
forall a. C a => a
one
in T a -> T a -> T a
forall a. C a => T a -> T a -> T a
envelope (T a
leadIn T a -> T a -> T a
forall a. T a -> T a -> T a
`Sig.append` T a
hold T a -> T a -> T a
forall a. T a -> T a -> T a
`Sig.append` T a
leadOut)
{-# INLINE generic #-}
generic :: (Module.C a v) =>
Sig.T a -> Sig.T v -> Sig.T v
generic :: forall a v. C a v => T a -> T v -> T v
generic T a
m T v
x =
let mr :: T a
mr = T a -> T a
forall a. T a -> T a
Sig.reverse T a
m
xp :: T v
xp = Int -> T v -> T v
forall y. C y => Int -> T y -> T y
Delay.staticPos (Int -> Int
forall a. Enum a => a -> a
pred (T a -> Int
forall a. T a -> Int
Sig.length T a
m)) T v
x
in (T v -> v) -> T v -> T v
forall y0 y1. (T y0 -> y1) -> T y0 -> T y1
Sig.mapTails (T a -> T v -> v
forall t y. C t y => T t -> T y -> y
Sig.linearComb T a
mr) T v
xp
{-# INLINE binomial #-}
binomial ::
(Trans.C a, RealField.C a, Module.C a v) =>
a -> a -> Sig.T v -> Sig.T v
binomial :: forall a v. (C a, C a, C a v) => a -> a -> T v -> T v
binomial a
ratio a
freq =
let width :: Int
width = a -> Int
forall b. C b => a -> b
forall a b. (C a, C b) => a -> b
ceiling (a
2 a -> a -> a
forall a. C a => a -> a -> a
* a -> a -> a
forall a. C a => a -> a -> a
ratioFreqToVariance a
ratio a
freq a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer
2)
in Int -> T v -> T v
forall a. Int -> T a -> T a
Sig.drop Int
width (T v -> T v) -> (T v -> T v) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (T v -> T v) -> T v -> T v
forall a. Int -> (a -> a) -> a -> a
nest (Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*Int
width) ((a -> a -> a
forall a. a -> a -> a
asTypeOf a
0.5 a
freq a -> T v -> T v
forall a v. C a v => a -> v -> v
*>) (T v -> T v) -> (T v -> T v) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T v -> T v
forall v. C v => T v -> T v
binomial1)
{-# INLINE binomial1 #-}
binomial1 :: (Additive.C v) => Sig.T v -> Sig.T v
binomial1 :: forall v. C v => T v -> T v
binomial1 = (v -> v -> v) -> T v -> T v
forall a b. (a -> a -> b) -> T a -> T b
Sig.mapAdjacent v -> v -> v
forall a. C a => a -> a -> a
(+)
{-# INLINE sums #-}
sums :: (Additive.C v) => Int -> Sig.T v -> Sig.T v
sums :: forall y. C y => Int -> T y -> T y
sums Int
n = (T v -> v) -> T v -> T v
forall y0 y1. (T y0 -> y1) -> T y0 -> T y1
Sig.mapTails (T v -> v
forall a. C a => T a -> a
Sig.sum (T v -> v) -> (T v -> T v) -> T v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> T v -> T v
forall a. Int -> T a -> T a
Sig.take Int
n)
{-# INLINE inverseFrequencyModulationFloor #-}
inverseFrequencyModulationFloor ::
(Ord t, Ring.C t) =>
Sig.T t -> Sig.T v -> Sig.T v
inverseFrequencyModulationFloor :: forall t v. (Ord t, C t) => T t -> T v -> T v
inverseFrequencyModulationFloor =
(t -> Bool) -> T t -> T v -> T v
forall t v. (Ord t, C t) => (t -> Bool) -> T t -> T v -> T v
inverseFrequencyModulationGen (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<t
1)
{-# INLINE inverseFrequencyModulationCeiling #-}
inverseFrequencyModulationCeiling ::
(Ord t, Ring.C t) =>
Sig.T t -> Sig.T v -> Sig.T v
inverseFrequencyModulationCeiling :: forall t v. (Ord t, C t) => T t -> T v -> T v
inverseFrequencyModulationCeiling =
(t -> Bool) -> T t -> T v -> T v
forall t v. (Ord t, C t) => (t -> Bool) -> T t -> T v -> T v
inverseFrequencyModulationGen (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<=t
0)
{-# INLINE inverseFrequencyModulationGen #-}
inverseFrequencyModulationGen ::
(Ord t, Ring.C t) =>
(t -> Bool) ->
Sig.T t -> Sig.T v -> Sig.T v
inverseFrequencyModulationGen :: forall t v. (Ord t, C t) => (t -> Bool) -> T t -> T v -> T v
inverseFrequencyModulationGen t -> Bool
p T t
ctrl T v
xs =
T (t, v)
-> (forall s.
(forall z. z -> ((t, v) -> s -> z) -> s -> z) -> s -> T v)
-> T v
forall y x.
T y
-> (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x)
-> x
Sig.runSwitchL
(T t -> T v -> T (t, v)
forall a b. T a -> T b -> T (a, b)
Sig.zip T t
ctrl T v
xs)
(\forall z. z -> ((t, v) -> s -> z) -> s -> z
switch ->
T v -> ((t, v) -> s -> T v) -> s -> T v
forall z. z -> ((t, v) -> s -> z) -> s -> z
switch T v
forall a. T a
Sig.empty
((((t, v), s) -> T v) -> (t, v) -> s -> T v
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((((t, v), s) -> T v) -> (t, v) -> s -> T v)
-> (((t, v), s) -> T v) -> (t, v) -> s -> T v
forall a b. (a -> b) -> a -> b
$
(((t, v), s) -> Maybe (v, ((t, v), s))) -> ((t, v), s) -> T v
forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
Sig.unfoldR
(let go :: (t, v) -> s -> Maybe (v, ((t, v), s))
go (t
c,v
x) s
cxs =
if t -> Bool
p t
c
then Maybe (v, ((t, v), s))
-> ((t, v) -> s -> Maybe (v, ((t, v), s)))
-> s
-> Maybe (v, ((t, v), s))
forall z. z -> ((t, v) -> s -> z) -> s -> z
switch Maybe (v, ((t, v), s))
forall a. Maybe a
Nothing ((t, v) -> s -> Maybe (v, ((t, v), s))
go ((t, v) -> s -> Maybe (v, ((t, v), s)))
-> ((t, v) -> (t, v)) -> (t, v) -> s -> Maybe (v, ((t, v), s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> t) -> (t, v) -> (t, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (t
ct -> t -> t
forall a. C a => a -> a -> a
+)) s
cxs
else (v, ((t, v), s)) -> Maybe (v, ((t, v), s))
forall a. a -> Maybe a
Just (v
x, ((t
ct -> t -> t
forall a. C a => a -> a -> a
-t
1,v
x),s
cxs))
in ((t, v) -> s -> Maybe (v, ((t, v), s)))
-> ((t, v), s) -> Maybe (v, ((t, v), s))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (t, v) -> s -> Maybe (v, ((t, v), s))
go)))
{-# INLINE differentiate #-}
differentiate :: Additive.C v => Sig.T v -> Sig.T v
differentiate :: forall v. C v => T v -> T v
differentiate T v
x = (v -> v -> v) -> T v -> T v
forall a b. (a -> a -> b) -> T a -> T b
Sig.mapAdjacent v -> v -> v
forall a. C a => a -> a -> a
subtract T v
x
{-# INLINE differentiateCenter #-}
differentiateCenter :: Field.C v => Sig.T v -> Sig.T v
differentiateCenter :: forall v. C v => T v -> T v
differentiateCenter =
((v, v) -> (v, v) -> v) -> T (v, v) -> T v
forall a b. (a -> a -> b) -> T a -> T b
Sig.mapAdjacent (\(v
x0,v
_) (v
_,v
x1) -> (v
x1 v -> v -> v
forall a. C a => a -> a -> a
- v
x0) v -> v -> v
forall a. C a => a -> a -> a
* (v
1v -> v -> v
forall a. C a => a -> a -> a
/v
2)) (T (v, v) -> T v) -> (T v -> T (v, v)) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(v -> v -> (v, v)) -> T v -> T (v, v)
forall a b. (a -> a -> b) -> T a -> T b
Sig.mapAdjacent (,)
{-# INLINE differentiate2 #-}
differentiate2 :: Additive.C v => Sig.T v -> Sig.T v
differentiate2 :: forall v. C v => T v -> T v
differentiate2 = T v -> T v
forall v. C v => T v -> T v
differentiate (T v -> T v) -> (T v -> T v) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T v -> T v
forall v. C v => T v -> T v
differentiate