{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Filter.Recursive.FirstOrder where
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Control.Applicative as App
import Control.Monad.Trans.State (State, state, )
import Control.Applicative (pure, liftA2, )
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import qualified Foreign.Storable.Newtype as Store
import qualified Foreign.Storable.Traversable as StoreTrav
import Foreign.Storable (Storable(sizeOf, alignment, peek, poke))
import qualified Test.QuickCheck as QC
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
newtype Parameter a = Parameter {forall a. Parameter a -> a
getParameter :: a}
deriving (Parameter a -> Parameter a -> Bool
(Parameter a -> Parameter a -> Bool)
-> (Parameter a -> Parameter a -> Bool) -> Eq (Parameter a)
forall a. Eq a => Parameter a -> Parameter a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Parameter a -> Parameter a -> Bool
== :: Parameter a -> Parameter a -> Bool
$c/= :: forall a. Eq a => Parameter a -> Parameter a -> Bool
/= :: Parameter a -> Parameter a -> Bool
Eq, Int -> Parameter a -> ShowS
[Parameter a] -> ShowS
Parameter a -> String
(Int -> Parameter a -> ShowS)
-> (Parameter a -> String)
-> ([Parameter a] -> ShowS)
-> Show (Parameter a)
forall a. Show a => Int -> Parameter a -> ShowS
forall a. Show a => [Parameter a] -> ShowS
forall a. Show a => Parameter a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Parameter a -> ShowS
showsPrec :: Int -> Parameter a -> ShowS
$cshow :: forall a. Show a => Parameter a -> String
show :: Parameter a -> String
$cshowList :: forall a. Show a => [Parameter a] -> ShowS
showList :: [Parameter a] -> ShowS
Show)
instance Functor Parameter where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Parameter a -> Parameter b
fmap a -> b
f (Parameter a
k) = b -> Parameter b
forall a. a -> Parameter a
Parameter (a -> b
f a
k)
instance App.Applicative Parameter where
{-# INLINE pure #-}
pure :: forall a. a -> Parameter a
pure a
x = a -> Parameter a
forall a. a -> Parameter a
Parameter a
x
{-# INLINE (<*>) #-}
Parameter a -> b
f <*> :: forall a b. Parameter (a -> b) -> Parameter a -> Parameter b
<*> Parameter a
k =
b -> Parameter b
forall a. a -> Parameter a
Parameter (a -> b
f a
k)
instance Fold.Foldable Parameter where
{-# INLINE foldMap #-}
foldMap :: forall m a. Monoid m => (a -> m) -> Parameter a -> m
foldMap = (a -> m) -> Parameter a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault
instance Trav.Traversable Parameter where
{-# INLINE sequenceA #-}
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Parameter (f a) -> f (Parameter a)
sequenceA (Parameter f a
k) =
(a -> Parameter a) -> f a -> f (Parameter a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Parameter a
forall a. a -> Parameter a
Parameter f a
k
instance Interpol.C a v => Interpol.C a (Parameter v) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, Parameter v) -> (Parameter v, Parameter v -> Parameter v)
scaleAndAccumulate = (v -> Parameter v)
-> (Parameter v -> v)
-> (a, Parameter v)
-> (Parameter v, Parameter v -> Parameter v)
forall a x v.
C a x =>
(x -> v) -> (v -> x) -> (a, v) -> (v, v -> v)
Interpol.makeMac v -> Parameter v
forall a. a -> Parameter a
Parameter Parameter v -> v
forall a. Parameter a -> a
getParameter
instance Storable a => Storable (Parameter a) where
sizeOf :: Parameter a -> Int
sizeOf = (Parameter a -> a) -> Parameter a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf Parameter a -> a
forall a. Parameter a -> a
getParameter
alignment :: Parameter a -> Int
alignment = (Parameter a -> a) -> Parameter a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment Parameter a -> a
forall a. Parameter a -> a
getParameter
peek :: Ptr (Parameter a) -> IO (Parameter a)
peek = (a -> Parameter a) -> Ptr (Parameter a) -> IO (Parameter a)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek a -> Parameter a
forall a. a -> Parameter a
Parameter
poke :: Ptr (Parameter a) -> Parameter a -> IO ()
poke = (Parameter a -> a) -> Ptr (Parameter a) -> Parameter a -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke Parameter a -> a
forall a. Parameter a -> a
getParameter
instance QC.Arbitrary a => QC.Arbitrary (Parameter a) where
arbitrary :: Gen (Parameter a)
arbitrary = (a -> Parameter a) -> Gen a -> Gen (Parameter a)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Parameter a
forall a. a -> Parameter a
Parameter Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary
{-# INLINE parameter #-}
parameter :: Trans.C a => a -> Parameter a
parameter :: forall a. C a => a -> Parameter a
parameter a
freq = a -> Parameter a
forall a. a -> Parameter a
Parameter (a -> a
forall a. C a => a -> a
exp (-a
2a -> a -> a
forall a. C a => a -> a -> a
*a
forall a. C a => a
pia -> a -> a
forall a. C a => a -> a -> a
*a
freq))
{-# INLINE lowpassStep #-}
lowpassStep :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State v v
lowpassStep :: forall a v. (C a, C a v) => Parameter a -> v -> State v v
lowpassStep (Parameter a
c) v
x =
(v -> (v, v)) -> StateT v Identity v
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (\v
s -> let y :: v
y = v
x v -> v -> v
forall a. C a => a -> a -> a
+ a
c a -> v -> v
forall a v. C a v => a -> v -> v
*> (v
sv -> v -> v
forall a. C a => a -> a -> a
-v
x) in (v
y,v
y))
{-# INLINE lowpassModifierInit #-}
lowpassModifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized v v (Parameter a) v v
lowpassModifierInit :: forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
lowpassModifierInit =
(v -> v)
-> (Parameter a -> v -> State v v)
-> Initialized v v (Parameter a) v v
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized v -> v
forall a. a -> a
id Parameter a -> v -> State v v
forall a v. (C a, C a v) => Parameter a -> v -> State v v
lowpassStep
{-# INLINE lowpassModifier #-}
lowpassModifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple v (Parameter a) v v
lowpassModifier :: forall a v. (C a, C a v) => Simple v (Parameter a) v v
lowpassModifier =
ModifierInit v v (Parameter a) v v
-> v -> Modifier v (Parameter a) v v
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize ModifierInit v v (Parameter a) v v
forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
lowpassModifierInit v
forall a. C a => a
zero
{-# INLINE lowpassCausal #-}
lowpassCausal ::
(Ring.C a, Module.C a v) =>
Causal.T (Parameter a, v) v
lowpassCausal :: forall a v. (C a, C a v) => T (Parameter a, v) v
lowpassCausal =
Simple v (Parameter a) v v -> T (Parameter a, v) v
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier Simple v (Parameter a) v v
forall a v. (C a, C a v) => Simple v (Parameter a) v v
lowpassModifier
{-# INLINE lowpassInit #-}
lowpassInit :: (Ring.C a, Module.C a v) =>
v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpassInit :: forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
lowpassInit =
ModifierInit v v (Parameter a) v v
-> v -> T (Parameter a) -> T v -> T v
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
Sig.modifyModulatedInit ModifierInit v v (Parameter a) v v
forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
lowpassModifierInit
{-# INLINE lowpass #-}
lowpass :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
lowpass :: forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
lowpass = v -> T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
lowpassInit v
forall a. C a => a
zero
{-# INLINE highpassStep #-}
highpassStep :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State v v
highpassStep :: forall a v. (C a, C a v) => Parameter a -> v -> State v v
highpassStep Parameter a
c v
x =
(v -> v) -> StateT v Identity v -> StateT v Identity v
forall a b. (a -> b) -> StateT v Identity a -> StateT v Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v
xv -> v -> v
forall a. C a => a -> a -> a
-) (Parameter a -> v -> StateT v Identity v
forall a v. (C a, C a v) => Parameter a -> v -> State v v
lowpassStep Parameter a
c v
x)
{-# INLINE highpassModifierInit #-}
highpassModifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized v v (Parameter a) v v
highpassModifierInit :: forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
highpassModifierInit =
(v -> v)
-> (Parameter a -> v -> State v v)
-> Initialized v v (Parameter a) v v
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized v -> v
forall a. a -> a
id Parameter a -> v -> State v v
forall a v. (C a, C a v) => Parameter a -> v -> State v v
highpassStep
{-# INLINE highpassModifier #-}
highpassModifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple v (Parameter a) v v
highpassModifier :: forall a v. (C a, C a v) => Simple v (Parameter a) v v
highpassModifier =
ModifierInit v v (Parameter a) v v
-> v -> Modifier v (Parameter a) v v
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize ModifierInit v v (Parameter a) v v
forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
highpassModifierInit v
forall a. C a => a
zero
{-# INLINE highpassInit #-}
highpassInit :: (Ring.C a, Module.C a v) =>
v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpassInit :: forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
highpassInit =
ModifierInit v v (Parameter a) v v
-> v -> T (Parameter a) -> T v -> T v
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
Sig.modifyModulatedInit ModifierInit v v (Parameter a) v v
forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
highpassModifierInit
highpassInitAlt :: (Ring.C a, Module.C a v) =>
v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpassInitAlt :: forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
highpassInitAlt v
y0 T (Parameter a)
control T v
x =
(v -> v -> v) -> T v -> T v -> T v
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) T v
x (T v -> T v) -> T v -> T v
forall a b. (a -> b) -> a -> b
$ v -> T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
lowpassInit v
y0 T (Parameter a)
control T v
x
{-# INLINE highpass #-}
highpass :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
highpass :: forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
highpass = v -> T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
highpassInit v
forall a. C a => a
zero
data Result a = Result {forall a. Result a -> a
highpass_, forall a. Result a -> a
lowpass_ :: !a}
deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
/= :: Result a -> Result a -> Bool
Eq)
instance Functor Result where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f Result a
p = b -> b -> Result b
forall a. a -> a -> Result a
Result (a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Result a -> a
forall a. Result a -> a
highpass_ Result a
p) (a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Result a -> a
forall a. Result a -> a
lowpass_ Result a
p)
instance App.Applicative Result where
{-# INLINE pure #-}
pure :: forall a. a -> Result a
pure a
x = a -> a -> Result a
forall a. a -> a -> Result a
Result a
x a
x
{-# INLINE (<*>) #-}
Result (a -> b)
f <*> :: forall a b. Result (a -> b) -> Result a -> Result b
<*> Result a
p = b -> b -> Result b
forall a. a -> a -> Result a
Result (Result (a -> b) -> a -> b
forall a. Result a -> a
highpass_ Result (a -> b)
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Result a -> a
forall a. Result a -> a
highpass_ Result a
p) (Result (a -> b) -> a -> b
forall a. Result a -> a
lowpass_ Result (a -> b)
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Result a -> a
forall a. Result a -> a
lowpass_ Result a
p)
instance Fold.Foldable Result where
{-# INLINE foldMap #-}
foldMap :: forall m a. Monoid m => (a -> m) -> Result a -> m
foldMap = (a -> m) -> Result a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault
instance Trav.Traversable Result where
{-# INLINE sequenceA #-}
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Result (f a) -> f (Result a)
sequenceA Result (f a)
p = (a -> a -> Result a) -> f a -> f a -> f (Result a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Result a
forall a. a -> a -> Result a
Result (Result (f a) -> f a
forall a. Result a -> a
highpass_ Result (f a)
p) (Result (f a) -> f a
forall a. Result a -> a
lowpass_ Result (f a)
p)
instance Additive.C v => Additive.C (Result v) where
{-# INLINE zero #-}
{-# INLINE (+) #-}
{-# INLINE (-) #-}
{-# INLINE negate #-}
zero :: Result v
zero = v -> Result v
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
forall a. C a => a
zero
+ :: Result v -> Result v -> Result v
(+) = (v -> v -> v) -> Result v -> Result v -> Result v
forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall a. C a => a -> a -> a
(+)
(-) = (v -> v -> v) -> Result v -> Result v -> Result v
forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
negate :: Result v -> Result v
negate = (v -> v) -> Result v -> Result v
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall a. C a => a -> a
negate
instance Module.C a v => Module.C a (Result v) where
{-# INLINE (*>) #-}
a
s*> :: a -> Result v -> Result v
*>Result v
v = (v -> v) -> Result v -> Result v
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
sa -> v -> v
forall a v. C a v => a -> v -> v
*>) Result v
v
instance Storable a => Storable (Result a) where
sizeOf :: Result a -> Int
sizeOf = Result a -> Int
forall (f :: * -> *) a. (Foldable f, Storable a) => f a -> Int
StoreTrav.sizeOf
alignment :: Result a -> Int
alignment = Result a -> Int
forall (f :: * -> *) a. (Foldable f, Storable a) => f a -> Int
StoreTrav.alignment
peek :: Ptr (Result a) -> IO (Result a)
peek = Ptr (Result a) -> IO (Result a)
forall (f :: * -> *) a.
(Applicative f, Traversable f, Storable a) =>
Ptr (f a) -> IO (f a)
StoreTrav.peekApplicative
poke :: Ptr (Result a) -> Result a -> IO ()
poke = Ptr (Result a) -> Result a -> IO ()
forall (f :: * -> *) a.
(Foldable f, Storable a) =>
Ptr (f a) -> f a -> IO ()
StoreTrav.poke
instance QC.Arbitrary a => QC.Arbitrary (Result a) where
arbitrary :: Gen (Result a)
arbitrary = (a -> a -> Result a) -> Gen a -> Gen a -> Gen (Result a)
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Result a
forall a. a -> a -> Result a
Result Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary
{-# INLINE step #-}
step :: (Module.C a v) =>
Parameter a -> v -> State v (Result v)
step :: forall a v. C a v => Parameter a -> v -> State v (Result v)
step Parameter a
c v
x =
(v -> Result v)
-> StateT v Identity v -> StateT v Identity (Result v)
forall a b. (a -> b) -> StateT v Identity a -> StateT v Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\v
lp -> v -> v -> Result v
forall a. a -> a -> Result a
Result (v
xv -> v -> v
forall a. C a => a -> a -> a
-v
lp) v
lp) (Parameter a -> v -> StateT v Identity v
forall a v. (C a, C a v) => Parameter a -> v -> State v v
lowpassStep Parameter a
c v
x)
{-# INLINE modifierInit #-}
modifierInit :: (Module.C a v) =>
Modifier.Initialized v v (Parameter a) v (Result v)
modifierInit :: forall a v. C a v => Initialized v v (Parameter a) v (Result v)
modifierInit =
(v -> v)
-> (Parameter a -> v -> State v (Result v))
-> Initialized v v (Parameter a) v (Result v)
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized v -> v
forall a. a -> a
id Parameter a -> v -> State v (Result v)
forall a v. C a v => Parameter a -> v -> State v (Result v)
step
{-# INLINE modifier #-}
modifier :: (Module.C a v) =>
Modifier.Simple v (Parameter a) v (Result v)
modifier :: forall a v. C a v => Simple v (Parameter a) v (Result v)
modifier =
ModifierInit v v (Parameter a) v (Result v)
-> v -> Modifier v (Parameter a) v (Result v)
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize ModifierInit v v (Parameter a) v (Result v)
forall a v. C a v => Initialized v v (Parameter a) v (Result v)
modifierInit v
forall a. C a => a
zero
{-# INLINE causal #-}
causal ::
(Module.C a v) =>
Causal.T (Parameter a, v) (Result v)
causal :: forall a v. C a v => T (Parameter a, v) (Result v)
causal =
Simple v (Parameter a) v (Result v)
-> T (Parameter a, v) (Result v)
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier Simple v (Parameter a) v (Result v)
forall a v. C a v => Simple v (Parameter a) v (Result v)
modifier
{-# INLINE causalInit #-}
causalInit ::
(Module.C a v) =>
v -> Causal.T (Parameter a, v) (Result v)
causalInit :: forall a v. C a v => v -> T (Parameter a, v) (Result v)
causalInit =
Initialized v v (Parameter a) v (Result v)
-> v -> T (Parameter a, v) (Result v)
forall s init ctrl a b.
Initialized s init ctrl a b -> init -> T (ctrl, a) b
Causal.fromInitializedModifier Initialized v v (Parameter a) v (Result v)
forall a v. C a v => Initialized v v (Parameter a) v (Result v)
modifierInit