{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Filter.Recursive.SecondOrder (
Parameter (Parameter, c0, c1, c2, d1, d2),
State (State, u1, u2, y1, y2),
adjustPassband,
amplify,
causal,
modifier,
modifierInit,
run,
runInit,
step,
zeroState,
) where
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass))
import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Control.Applicative.HT as App
import Control.Applicative (Applicative, pure, (<*>), )
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import qualified Synthesizer.Causal.Process as Causal
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import Data.List (zipWith6)
import qualified Control.Monad.Trans.State as MS
import qualified Foreign.Storable.Record as Store
import Foreign.Storable (Storable(..))
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter {forall a. Parameter a -> a
c0, forall a. Parameter a -> a
c1, forall a. Parameter a -> a
c2, forall a. Parameter a -> a
d1, forall a. Parameter a -> a
d2 :: !a}
deriving 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
p = forall a. a -> a -> a -> a -> a -> Parameter a
Parameter
(a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
c0 Parameter a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
c1 Parameter a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
c2 Parameter a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
d1 Parameter a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
d2 Parameter a
p)
instance Applicative Parameter where
{-# INLINE pure #-}
pure :: forall a. a -> Parameter a
pure a
x = forall a. a -> a -> a -> a -> a -> Parameter a
Parameter a
x a
x a
x a
x a
x
{-# INLINE (<*>) #-}
Parameter (a -> b)
f <*> :: forall a b. Parameter (a -> b) -> Parameter a -> Parameter b
<*> Parameter a
p = forall a. a -> a -> a -> a -> a -> Parameter a
Parameter
(forall a. Parameter a -> a
c0 Parameter (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
c0 Parameter a
p) (forall a. Parameter a -> a
c1 Parameter (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
c1 Parameter a
p) (forall a. Parameter a -> a
c2 Parameter (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
c2 Parameter a
p) (forall a. Parameter a -> a
d1 Parameter (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
d1 Parameter a
p) (forall a. Parameter a -> a
d2 Parameter (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. Parameter a -> a
d2 Parameter a
p)
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)
p =
forall (m :: * -> *) a b c d e r.
Applicative m =>
(a -> b -> c -> d -> e -> r)
-> m a -> m b -> m c -> m d -> m e -> m r
App.lift5 forall a. a -> a -> a -> a -> a -> Parameter a
Parameter
(forall a. Parameter a -> a
c0 Parameter (f a)
p) (forall a. Parameter a -> a
c1 Parameter (f a)
p) (forall a. Parameter a -> a
c2 Parameter (f a)
p) (forall a. Parameter a -> a
d1 Parameter (f a)
p) (forall a. Parameter a -> a
d2 Parameter (f a)
p)
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 v x. MAC a v x -> (a, v) -> (x, v -> x)
Interpol.runMac forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b c d e r.
Applicative m =>
(a -> b -> c -> d -> e -> r)
-> m a -> m b -> m c -> m d -> m e -> m r
App.lift5 forall a. a -> a -> a -> a -> a -> Parameter a
Parameter
(forall a x v. C a x => (v -> x) -> MAC a v x
Interpol.element forall a. Parameter a -> a
c0)
(forall a x v. C a x => (v -> x) -> MAC a v x
Interpol.element forall a. Parameter a -> a
c1)
(forall a x v. C a x => (v -> x) -> MAC a v x
Interpol.element forall a. Parameter a -> a
c2)
(forall a x v. C a x => (v -> x) -> MAC a v x
Interpol.element forall a. Parameter a -> a
d1)
(forall a x v. C a x => (v -> x) -> MAC a v x
Interpol.element forall a. Parameter a -> a
d2)
data State a =
State {forall a. State a -> a
u1, forall a. State a -> a
u2, forall a. State a -> a
y1, forall a. State a -> a
y2 :: !a}
deriving Int -> State a -> ShowS
forall a. Show a => Int -> State a -> ShowS
forall a. Show a => [State a] -> ShowS
forall a. Show a => State a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State a] -> ShowS
$cshowList :: forall a. Show a => [State a] -> ShowS
show :: State a -> String
$cshow :: forall a. Show a => State a -> String
showsPrec :: Int -> State a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> State a -> ShowS
Show
zeroState :: Additive.C a => State a
zeroState :: forall a. C a => State a
zeroState =
State
{u1 :: a
u1 = forall a. C a => a
zero, u2 :: a
u2 = forall a. C a => a
zero,
y1 :: a
y1 = forall a. C a => a
zero, y2 :: a
y2 = forall a. C a => a
zero}
instance Functor State where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> State a -> State b
fmap a -> b
f State a
p = forall a. a -> a -> a -> a -> State a
State
(a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
u1 State a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
u2 State a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
y1 State a
p) (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
y2 State a
p)
instance Applicative State where
{-# INLINE pure #-}
pure :: forall a. a -> State a
pure a
x = forall a. a -> a -> a -> a -> State a
State a
x a
x a
x a
x
{-# INLINE (<*>) #-}
State (a -> b)
f <*> :: forall a b. State (a -> b) -> State a -> State b
<*> State a
p = forall a. a -> a -> a -> a -> State a
State
(forall a. State a -> a
u1 State (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
u1 State a
p) (forall a. State a -> a
u2 State (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
u2 State a
p) (forall a. State a -> a
y1 State (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
y1 State a
p) (forall a. State a -> a
y2 State (a -> b)
f forall a b. (a -> b) -> a -> b
$ forall a. State a -> a
y2 State a
p)
instance Fold.Foldable State where
{-# INLINE foldMap #-}
foldMap :: forall m a. Monoid m => (a -> m) -> State a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault
instance Trav.Traversable State where
{-# INLINE sequenceA #-}
sequenceA :: forall (f :: * -> *) a. Applicative f => State (f a) -> f (State a)
sequenceA State (f a)
p =
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 forall a. a -> a -> a -> a -> State a
State
(forall a. State a -> a
u1 State (f a)
p) (forall a. State a -> a
u2 State (f a)
p) (forall a. State a -> a
y1 State (f a)
p) (forall a. State a -> a
y2 State (f a)
p)
instance Storable a => Storable (Parameter a) where
sizeOf :: Parameter a -> Int
sizeOf = forall r. Dictionary r -> r -> Int
Store.sizeOf forall a. Storable a => Dictionary (Parameter a)
storeParameter
alignment :: Parameter a -> Int
alignment = forall r. Dictionary r -> r -> Int
Store.alignment forall a. Storable a => Dictionary (Parameter a)
storeParameter
peek :: Ptr (Parameter a) -> IO (Parameter a)
peek = forall r. Dictionary r -> Ptr r -> IO r
Store.peek forall a. Storable a => Dictionary (Parameter a)
storeParameter
poke :: Ptr (Parameter a) -> Parameter a -> IO ()
poke = forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke forall a. Storable a => Dictionary (Parameter a)
storeParameter
storeParameter ::
Storable a => Store.Dictionary (Parameter a)
storeParameter :: forall a. Storable a => Dictionary (Parameter a)
storeParameter =
forall r. Access r r -> Dictionary r
Store.run forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b c d e r.
Applicative m =>
(a -> b -> c -> d -> e -> r)
-> m a -> m b -> m c -> m d -> m e -> m r
App.lift5 forall a. a -> a -> a -> a -> a -> Parameter a
Parameter
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. Parameter a -> a
c0)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. Parameter a -> a
c1)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. Parameter a -> a
c2)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. Parameter a -> a
d1)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. Parameter a -> a
d2)
instance Storable a => Storable (State a) where
sizeOf :: State a -> Int
sizeOf = forall r. Dictionary r -> r -> Int
Store.sizeOf forall a. Storable a => Dictionary (State a)
storeState
alignment :: State a -> Int
alignment = forall r. Dictionary r -> r -> Int
Store.alignment forall a. Storable a => Dictionary (State a)
storeState
peek :: Ptr (State a) -> IO (State a)
peek = forall r. Dictionary r -> Ptr r -> IO r
Store.peek forall a. Storable a => Dictionary (State a)
storeState
poke :: Ptr (State a) -> State a -> IO ()
poke = forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke forall a. Storable a => Dictionary (State a)
storeState
storeState ::
Storable a => Store.Dictionary (State a)
storeState :: forall a. Storable a => Dictionary (State a)
storeState =
forall r. Access r r -> Dictionary r
Store.run forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b c d r.
Applicative m =>
(a -> b -> c -> d -> r) -> m a -> m b -> m c -> m d -> m r
App.lift4 forall a. a -> a -> a -> a -> State a
State
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. State a -> a
u1)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. State a -> a
u2)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. State a -> a
y1)
(forall a r. Storable a => (r -> a) -> Access r a
Store.element forall a. State a -> a
y2)
{-# INLINE adjustPassband #-}
adjustPassband :: (Field.C a) =>
Passband -> (a -> Parameter a) -> (a -> Parameter a)
adjustPassband :: forall a. C a => Passband -> (a -> Parameter a) -> a -> Parameter a
adjustPassband Passband
kind a -> Parameter a
comp a
f =
case Passband
kind of
Passband
Lowpass -> a -> Parameter a
comp a
f
Passband
Highpass ->
let p :: Parameter a
p = a -> Parameter a
comp (a
0.5forall a. C a => a -> a -> a
-a
f)
in forall a. a -> a -> a -> a -> a -> Parameter a
Parameter (forall a. Parameter a -> a
c0 Parameter a
p) (- forall a. Parameter a -> a
c1 Parameter a
p) (forall a. Parameter a -> a
c2 Parameter a
p) (- forall a. Parameter a -> a
d1 Parameter a
p) (forall a. Parameter a -> a
d2 Parameter a
p)
{-# INLINE amplify #-}
amplify :: (Ring.C a) =>
a -> Parameter a -> Parameter a
amplify :: forall a. C a => a -> Parameter a -> Parameter a
amplify a
a Parameter a
p =
Parameter a
p{c0 :: a
c0 = a
a forall a. C a => a -> a -> a
* forall a. Parameter a -> a
c0 Parameter a
p,
c1 :: a
c1 = a
a forall a. C a => a -> a -> a
* forall a. Parameter a -> a
c1 Parameter a
p,
c2 :: a
c2 = a
a forall a. C a => a -> a -> a
* forall a. Parameter a -> a
c2 Parameter a
p}
{-# INLINE step #-}
step :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> MS.State (State v) v
step :: forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
step Parameter a
c v
u0 = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state forall a b. (a -> b) -> a -> b
$ \State v
s ->
let y0 :: v
y0 =
forall a. Parameter a -> a
c0 Parameter a
c forall a v. C a v => a -> v -> v
*> v
u0 forall a. C a => a -> a -> a
+
forall a. Parameter a -> a
c1 Parameter a
c forall a v. C a v => a -> v -> v
*> forall a. State a -> a
u1 State v
s forall a. C a => a -> a -> a
+ forall a. Parameter a -> a
d1 Parameter a
c forall a v. C a v => a -> v -> v
*> forall a. State a -> a
y1 State v
s forall a. C a => a -> a -> a
+
forall a. Parameter a -> a
c2 Parameter a
c forall a v. C a v => a -> v -> v
*> forall a. State a -> a
u2 State v
s forall a. C a => a -> a -> a
+ forall a. Parameter a -> a
d2 Parameter a
c forall a v. C a v => a -> v -> v
*> forall a. State a -> a
y2 State v
s
in (v
y0, State
{u1 :: v
u1 = v
u0, u2 :: v
u2 = forall a. State a -> a
u1 State v
s,
y1 :: v
y1 = v
y0, y2 :: v
y2 = forall a. State a -> a
y1 State v
s})
{-# INLINE modifierInit #-}
modifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized (State v) (State v) (Parameter a) v v
modifierInit :: forall a v.
(C a, C a v) =>
Initialized (State v) (State v) (Parameter a) v 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, C a v) => Parameter a -> v -> State (State v) v
step
{-# INLINE modifier #-}
modifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple (State v) (Parameter a) v v
modifier :: forall a v. (C a, C a v) => Simple (State v) (Parameter a) v 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, C a v) =>
Initialized (State v) (State v) (Parameter a) v v
modifierInit forall a. C a => State a
zeroState
{-# INLINE causal #-}
causal :: (Ring.C a, Module.C a v) =>
Causal.T (Parameter a, v) v
causal :: forall a v. (C a, C a v) => T (Parameter a, v) v
causal =
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 (State v) (Parameter a) v v
modifier
{-# INLINE runInit #-}
runInit :: (Ring.C a, Module.C a v) =>
State v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
runInit :: forall a v.
(C a, C a v) =>
State v -> T (Parameter a) -> T v -> T v
runInit State v
sInit T (Parameter a)
control T v
input =
let u0s :: T v
u0s = T v
input
u1s :: T v
u1s = forall a. State a -> a
u1 State v
sInit forall a. a -> [a] -> [a]
: T v
u0s
u2s :: T v
u2s = forall a. State a -> a
u2 State v
sInit forall a. a -> [a] -> [a]
: T v
u1s
y1s :: T v
y1s = forall a. State a -> a
y1 State v
sInit forall a. a -> [a] -> [a]
: T v
y0s
y2s :: T v
y2s = forall a. State a -> a
y2 State v
sInit forall a. a -> [a] -> [a]
: T v
y1s
y0s :: T v
y0s = forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
zipWith6
(\Parameter a
c v
u0_ v
u1_ v
u2_ v
y1_ v
y2_ ->
forall a. Parameter a -> a
c0 Parameter a
c forall a v. C a v => a -> v -> v
*> v
u0_ forall a. C a => a -> a -> a
+
forall a. Parameter a -> a
c1 Parameter a
c forall a v. C a v => a -> v -> v
*> v
u1_ forall a. C a => a -> a -> a
+ forall a. Parameter a -> a
d1 Parameter a
c forall a v. C a v => a -> v -> v
*> v
y1_ forall a. C a => a -> a -> a
+
forall a. Parameter a -> a
c2 Parameter a
c forall a v. C a v => a -> v -> v
*> v
u2_ forall a. C a => a -> a -> a
+ forall a. Parameter a -> a
d2 Parameter a
c forall a v. C a v => a -> v -> v
*> v
y2_)
T (Parameter a)
control T v
u0s T v
u1s T v
u2s T v
y1s T v
y2s
in T v
y0s
{-# INLINE run #-}
run :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T v
run :: forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
run =
forall a v.
(C a, C a v) =>
State v -> T (Parameter a) -> T v -> T v
runInit forall a. C a => State a
zeroState