{-# 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
forall a. Eq a => Parameter a -> Parameter a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameter a -> Parameter a -> Bool
$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
Eq, Int -> Parameter a -> ShowS
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
showList :: [Parameter a] -> ShowS
$cshowList :: forall a. Show a => [Parameter a] -> ShowS
show :: Parameter a -> String
$cshow :: forall a. Show a => Parameter a -> String
showsPrec :: Int -> Parameter a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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) = 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 = 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 =
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 = 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) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall a x v.
C a x =>
(x -> v) -> (v -> x) -> (a, v) -> (v, v -> v)
Interpol.makeMac forall a. a -> Parameter a
Parameter forall a. Parameter a -> a
getParameter
instance Storable a => Storable (Parameter a) where
sizeOf :: Parameter a -> Int
sizeOf = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf forall a. Parameter a -> a
getParameter
alignment :: Parameter a -> Int
alignment = forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment forall a. Parameter a -> a
getParameter
peek :: Ptr (Parameter a) -> IO (Parameter a)
peek = forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek forall a. a -> Parameter a
Parameter
poke :: Ptr (Parameter a) -> Parameter a -> IO ()
poke = forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke forall a. Parameter a -> a
getParameter
instance QC.Arbitrary a => QC.Arbitrary (Parameter a) where
arbitrary :: Gen (Parameter a)
arbitrary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Parameter a
Parameter 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 = forall a. a -> Parameter a
Parameter (forall a. C a => a -> a
exp (-a
2forall a. C a => a -> a -> a
*forall a. C a => a
piforall 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 =
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (\v
s -> let y :: v
y = v
x forall a. C a => a -> a -> a
+ a
c forall a v. C a v => a -> v -> v
*> (v
sforall 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 =
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized forall a. a -> a
id 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 =
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
lowpassModifierInit 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 =
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier 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 =
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
Sig.modifyModulatedInit 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 = forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
lowpassInit 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v
xforall a. C a => a -> a -> a
-) (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 =
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized forall a. a -> a
id 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 =
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
highpassModifierInit 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 =
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
Sig.modifyModulatedInit 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 =
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) T v
x forall a b. (a -> b) -> a -> b
$ 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 = forall a v. (C a, C a v) => v -> T (Parameter a) -> T v -> T v
highpassInit 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
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$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
Eq)
instance Functor Result where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f Result a
p = forall a. a -> a -> Result a
Result (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Result a -> a
highpass_ Result a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall a. a -> a -> Result a
Result (forall a. Result a -> a
highpass_ Result (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Result a -> a
highpass_ Result a
p) (forall a. Result a -> a
lowpass_ Result (a -> b)
f forall a b. (a -> b) -> a -> b
$ 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 = 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 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> Result a
Result (forall a. Result a -> a
highpass_ Result (f a)
p) (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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. C a => a
zero
+ :: Result v -> Result v -> Result v
(+) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. C a => a -> a -> a
(+)
(-) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
negate :: Result v -> Result v
negate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
sforall a v. C a v => a -> v -> v
*>) Result v
v
instance Storable a => Storable (Result a) where
sizeOf :: Result a -> Int
sizeOf = forall (f :: * -> *) a. (Foldable f, Storable a) => f a -> Int
StoreTrav.sizeOf
alignment :: Result a -> Int
alignment = forall (f :: * -> *) a. (Foldable f, Storable a) => f a -> Int
StoreTrav.alignment
peek :: Ptr (Result a) -> IO (Result a)
peek = 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 = 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 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> Result a
Result forall a. Arbitrary a => Gen a
QC.arbitrary 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\v
lp -> forall a. a -> a -> Result a
Result (v
xforall a. C a => a -> a -> a
-v
lp) v
lp) (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 =
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized forall a. a -> a
id 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 =
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize forall a v. C a v => Initialized v v (Parameter a) v (Result v)
modifierInit 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 =
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier 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 =
forall s init ctrl a b.
Initialized s init ctrl a b -> init -> T (ctrl, a) b
Causal.fromInitializedModifier forall a v. C a v => Initialized v v (Parameter a) v (Result v)
modifierInit