{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Filter.Recursive.FirstOrderComplex (
Parameter,
parameter,
parameterFromPeakWidth,
parameterFromPeakToDCRatio,
step,
modifierInit,
modifier,
causal,
runInit,
run,
) where
import Synthesizer.Plain.Filter.Recursive (Pole(..))
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 Synthesizer.Basic.ComplexModule as CM
import qualified Number.Complex as Complex
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Ring as Ring
import Control.Monad.Trans.State (State, state, )
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter {forall a. Parameter a -> T a
c, forall a. Parameter a -> T a
amp :: !(Complex.T a)}
deriving 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 Interpol.C a v => Interpol.C a (Parameter v) where
{-# INLINE scaleAndAccumulate #-}
scaleAndAccumulate :: (a, Parameter v) -> (Parameter v, Parameter v -> Parameter v)
scaleAndAccumulate = (T v -> T v -> Parameter v)
-> (Parameter v -> T v)
-> (Parameter v -> T v)
-> (a, Parameter v)
-> (Parameter v, Parameter v -> Parameter v)
forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> (v, v -> v)
Interpol.makeMac2 T v -> T v -> Parameter v
forall a. T a -> T a -> Parameter a
Parameter Parameter v -> T v
forall a. Parameter a -> T a
c Parameter v -> T v
forall a. Parameter a -> T a
amp
{-# INLINE parameter #-}
parameter :: Trans.C a => Pole a -> Parameter a
parameter :: forall a. C a => Pole a -> Parameter a
parameter (Pole a
resonance a
frequency) =
let cisw :: T a
cisw = a -> T a
forall a. C a => a -> T a
Complex.cis (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
frequency)
k :: a
k = a
1 a -> a -> a
forall a. C a => a -> a -> a
- a -> a
forall a. C a => a -> a
recip a
resonance
kcisw :: T a
kcisw = a -> T a -> T a
forall a. C a => a -> T a -> T a
Complex.scale a
k T a
cisw
in T a -> T a -> Parameter a
forall a. T a -> T a -> Parameter a
Parameter T a
kcisw T a
forall a. C a => a
one
{-# INLINE parameterFromPeakWidth #-}
parameterFromPeakWidth :: Trans.C a => a -> Pole a -> Parameter a
parameterFromPeakWidth :: forall a. C a => a -> Pole a -> Parameter a
parameterFromPeakWidth a
width (Pole a
resonance a
frequency) =
let cisw :: T a
cisw = a -> T a
forall a. C a => a -> T a
Complex.cis (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
frequency)
k :: a
k = a -> a -> a
forall a. C a => a -> a -> a
solveRatio a
resonance (a -> a
forall a. C a => a -> a
cos (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
width))
kcisw :: T a
kcisw = a -> T a -> T a
forall a. C a => a -> T a -> T a
Complex.scale a
k T a
cisw
amp_ :: T a
amp_ = a -> T a
forall a. C a => a -> T a
Complex.fromReal ((a
1a -> a -> a
forall a. C a => a -> a -> a
-a
k)a -> a -> a
forall a. C a => a -> a -> a
*a
resonance)
in T a -> T a -> Parameter a
forall a. T a -> T a -> Parameter a
Parameter T a
kcisw T a
amp_
{-# INLINE parameterFromPeakToDCRatio #-}
parameterFromPeakToDCRatio :: Trans.C a => Pole a -> Parameter a
parameterFromPeakToDCRatio :: forall a. C a => Pole a -> Parameter a
parameterFromPeakToDCRatio (Pole a
resonance a
frequency) =
let cisw :: T a
cisw = a -> T a
forall a. C a => a -> T a
Complex.cis (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
frequency)
k :: a
k = a -> a -> a
forall a. C a => a -> a -> a
solveRatio a
resonance (T a -> a
forall a. T a -> a
Complex.real T a
cisw)
kcisw :: T a
kcisw = a -> T a -> T a
forall a. C a => a -> T a -> T a
Complex.scale a
k T a
cisw
amp_ :: T a
amp_ = T a
forall a. C a => a
one T a -> T a -> T a
forall a. C a => a -> a -> a
- T a
kcisw
in T a -> T a -> Parameter a
forall a. T a -> T a -> Parameter a
Parameter T a
kcisw T a
amp_
solveRatio :: (Algebraic.C a) =>
a -> a -> a
solveRatio :: forall a. C a => a -> a -> a
solveRatio a
resonance a
cosine =
let r2 :: a
r2 = a
resonancea -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2
p :: a
p = (a
r2 a -> a -> a
forall a. C a => a -> a -> a
- a
cosine) a -> a -> a
forall a. C a => a -> a -> a
/ (a
r2 a -> a -> a
forall a. C a => a -> a -> a
- a
1)
in a -> a
forall a. C a => a -> a
recip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
p a -> a -> a
forall a. C a => a -> a -> a
+ a -> a
forall a. C a => a -> a
sqrt (a
pa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
- a
1)
type Result = Complex.T
{-# INLINE step #-}
step :: (Module.C a v) =>
Parameter a -> v -> State (Complex.T v) (Result v)
step :: forall a v. C a v => Parameter a -> v -> State (T v) (T v)
step Parameter a
p v
u =
(T v -> (T v, T v)) -> StateT (T v) Identity (T v)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((T v -> (T v, T v)) -> StateT (T v) Identity (T v))
-> (T v -> (T v, T v)) -> StateT (T v) Identity (T v)
forall a b. (a -> b) -> a -> b
$ \T v
s ->
let y :: T v
y = T a -> v -> T v
forall a v. C a v => T a -> v -> T v
CM.scale (Parameter a -> T a
forall a. Parameter a -> T a
amp Parameter a
p) v
u T v -> T v -> T v
forall a. C a => a -> a -> a
+ T a -> T v -> T v
forall a v. C a v => T a -> T v -> T v
CM.mul (Parameter a -> T a
forall a. Parameter a -> T a
c Parameter a
p) T v
s
in (T v
y, T v
y)
{-# INLINE modifierInit #-}
modifierInit :: (Ring.C a, Module.C a v) =>
Modifier.Initialized (Complex.T v) (Complex.T v) (Parameter a) v (Result v)
modifierInit :: forall a v.
(C a, C a v) =>
Initialized (T v) (T v) (Parameter a) v (T v)
modifierInit =
(T v -> T v)
-> (Parameter a -> v -> State (T v) (T v))
-> Initialized (T v) (T v) (Parameter a) v (T v)
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized T v -> T v
forall a. a -> a
id Parameter a -> v -> State (T v) (T v)
forall a v. C a v => Parameter a -> v -> State (T v) (T v)
step
{-# INLINE modifier #-}
modifier :: (Ring.C a, Module.C a v) =>
Modifier.Simple (Complex.T v) (Parameter a) v (Result v)
modifier :: forall a v. (C a, C a v) => Simple (T v) (Parameter a) v (T v)
modifier = ModifierInit (T v) (T v) (Parameter a) v (T v)
-> T v -> Modifier (T v) (Parameter a) v (T v)
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize ModifierInit (T v) (T v) (Parameter a) v (T v)
forall a v.
(C a, C a v) =>
Initialized (T v) (T v) (Parameter a) v (T v)
modifierInit T v
forall a. C a => a
zero
{-# INLINE causal #-}
causal ::
(Ring.C a, Module.C a v) =>
Causal.T (Parameter a, v) (Result v)
causal :: forall a v. (C a, C a v) => T (Parameter a, v) (Result v)
causal =
Simple (T v) (Parameter a) v (T v) -> T (Parameter a, v) (T v)
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier Simple (T v) (Parameter a) v (T v)
forall a v. (C a, C a v) => Simple (T v) (Parameter a) v (T v)
modifier
{-# INLINE runInit #-}
runInit :: (Ring.C a, Module.C a v) =>
Complex.T v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T (Result v)
runInit :: forall a v.
(C a, C a v) =>
T v -> T (Parameter a) -> T v -> T (T v)
runInit = ModifierInit (T v) (T v) (Parameter a) v (T v)
-> T v -> T (Parameter a) -> T v -> T (T v)
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
Sig.modifyModulatedInit ModifierInit (T v) (T v) (Parameter a) v (T v)
forall a v.
(C a, C a v) =>
Initialized (T v) (T v) (Parameter a) v (T v)
modifierInit
{-# INLINE run #-}
run :: (Ring.C a, Module.C a v) =>
Sig.T (Parameter a) -> Sig.T v -> Sig.T (Result v)
run :: forall a v. (C a, C a v) => T (Parameter a) -> T v -> T (Result v)
run = T v -> T (Parameter a) -> T v -> T (T v)
forall a v.
(C a, C a v) =>
T v -> T (Parameter a) -> T v -> T (T v)
runInit T v
forall a. C a => a
zero