{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
Copyright   :  (c) Henning Thielemann 2008-2011
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

First order low pass and high pass filter.
-}
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


{-| Convert cut-off frequency to feedback factor. -}
{-# 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
{-
   zero = Result zero zero
   (+) (Result xhp xlp) (Result yhp ylp) = Result (xhp + yhp) (xlp + ylp)
   (-) (Result xhp xlp) (Result yhp ylp) = Result (xhp - yhp) (xlp - ylp)
   negate               (Result xhp xlp) = Result (negate xhp) (negate xlp)
-}

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
{-
   s *> (Result hp lp) = Result (s *> hp) (s *> lp)
-}

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