{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Plain.Filter.Recursive.Hilbert (
Parameter (Parameter, parameterCosine, parameterSine),
polesCosine, polesSine,
parameter,
step2,
modifierInit2,
runInit2, run2,
cascade,
causal2, causalComplex2,
causal, causalComplex,
lowpassStream,
lowpassMaintainPhase,
) where
import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.ComplexModule as CM
import Control.Arrow ((<<<), (>>>), (&&&), (>>^), )
import Control.Monad.Trans.State (State, state, runState, )
import qualified Data.List.Match as Match
import qualified Algebra.Module as Module
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Number.Complex as Complex
import Number.Complex ((+:), )
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter {forall a. Parameter a -> [Parameter a]
parameterCosine, forall a. Parameter a -> [Parameter a]
parameterSine :: [Allpass.Parameter 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
polesCosine, polesSine :: Field.C a => [a]
polesCosine :: forall a. C a => [a]
polesCosine = [a
1.2524, a
5.5671, a
22.3423, a
89.6271, a
364.7914, a
2770.1114]
polesSine :: forall a. C a => [a]
polesSine = [a
0.3609, a
2.7412, a
11.1573, a
44.7581, a
179.6242, a
798.4578]
{-# INLINE parameter #-}
parameter :: Trans.C a => a -> Parameter a
parameter :: forall a. C a => a -> Parameter a
parameter a
rate =
forall a. [Parameter a] -> [Parameter a] -> Parameter a
Parameter
(forall a b. (a -> b) -> [a] -> [b]
map (forall a. C a => a -> a -> Parameter a
Allpass.parameterApprox (-a
1forall a. C a => a -> a -> a
/(a
15forall a. C a => a -> a -> a
*forall a. C a => a
pi)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. C a => a -> a -> a
/a
rate)) forall a. C a => [a]
polesCosine)
(forall a b. (a -> b) -> [a] -> [b]
map (forall a. C a => a -> a -> Parameter a
Allpass.parameterApprox (-a
1forall a. C a => a -> a -> a
/(a
15forall a. C a => a -> a -> a
*forall a. C a => a
pi)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. C a => a -> a -> a
/a
rate)) forall a. C a => [a]
polesSine)
{-# INLINE step2 #-}
step2 :: (Ring.C a, Module.C a v) =>
Parameter a -> v -> State [Complex.T v] (Complex.T v)
step2 :: forall a v. (C a, C a v) => Parameter a -> v -> State [T v] (T v)
step2 Parameter a
param v
x = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \[T v]
s ->
let mr :: State [v] v
mr = forall a v. (C a, C a v) => [Parameter a] -> v -> State [v] v
Allpass.cascadeDiverseStep (forall a. Parameter a -> [Parameter a]
parameterCosine Parameter a
param) v
x
mi :: State [v] v
mi = forall a v. (C a, C a v) => [Parameter a] -> v -> State [v] v
Allpass.cascadeDiverseStep (forall a. Parameter a -> [Parameter a]
parameterSine Parameter a
param) v
x
(v
r,[v]
sr) = forall s a. State s a -> s -> (a, s)
runState State [v] v
mr (forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
Complex.real [T v]
s)
(v
i,[v]
si) = forall s a. State s a -> s -> (a, s)
runState State [v] v
mi (forall a b. (a -> b) -> [a] -> [b]
map forall a. T a -> a
Complex.imag [T v]
s)
in (v
rforall a. a -> a -> T a
+:v
i, forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> a -> T a
(+:) [v]
sr [v]
si)
{-# INLINE modifierInit2 #-}
modifierInit2 :: (Ring.C a, Module.C a v) =>
Modifier.Initialized [Complex.T v] [Complex.T v] (Parameter a) v (Complex.T v)
modifierInit2 :: forall a v.
(C a, C a v) =>
Initialized [T v] [T v] (Parameter a) v (T v)
modifierInit2 =
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 [T v] (T v)
step2
cascade ::
(Ring.C a, Module.C a v) =>
[Allpass.Parameter a] -> Causal.T v v
cascade :: forall a v. (C a, C a v) => [Parameter a] -> T v v
cascade [Parameter a]
ps =
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>)
(forall a b. (a -> b) -> [a] -> [b]
map (\Parameter a
p -> forall a v. (C a, C a v) => T (Parameter a, v) v
Allpass.firstOrderCausal forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall a b. a -> T b (a, b)
Causal.feedConstFst Parameter a
p) [Parameter a]
ps)
{-# INLINE causal2 #-}
causal2 ::
(Ring.C a, Module.C a v) =>
Parameter a -> Causal.T v (Complex.T v)
causal2 :: forall a v. (C a, C a v) => Parameter a -> T v (T v)
causal2 Parameter a
param =
(forall a v. (C a, C a v) => [Parameter a] -> T v v
cascade (forall a. Parameter a -> [Parameter a]
parameterCosine Parameter a
param) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
forall a v. (C a, C a v) => [Parameter a] -> T v v
cascade (forall a. Parameter a -> [Parameter a]
parameterSine Parameter a
param))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> T a
(+:)
{-# INLINE causalComplex2 #-}
causalComplex2 ::
(Ring.C a, Module.C a v) =>
Parameter a -> Causal.T (Complex.T v) (Complex.T v)
causalComplex2 :: forall a v. (C a, C a v) => Parameter a -> T (T v) (T v)
causalComplex2 Parameter a
param =
(forall a v. (C a, C a v) => [Parameter a] -> T v v
cascade (forall a. Parameter a -> [Parameter a]
parameterCosine Parameter a
param) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
forall a v. (C a, C a v) => [Parameter a] -> T v v
cascade (forall a. Parameter a -> [Parameter a]
parameterSine Parameter a
param))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (\(T v
c,T v
s) -> T v
c forall a. C a => a -> a -> a
+ forall a. C a => T a -> T a
Complex.quarterLeft T v
s)
{-# INLINE scaleWithParamType #-}
scaleWithParamType ::
(Module.C a v) =>
Parameter a -> a -> v -> v
scaleWithParamType :: forall a v. C a v => Parameter a -> a -> v -> v
scaleWithParamType Parameter a
_ a
k v
v =
a
k forall a v. C a v => a -> v -> v
*> v
v
{-# INLINE causal #-}
causal ::
(Field.C a, Module.C a v) =>
Parameter a -> Causal.T v (Complex.T v)
causal :: forall a v. (C a, C a v) => Parameter a -> T v (T v)
causal Parameter a
param =
forall a v. (C a, C a v) => Parameter a -> T v (T v)
causal2 Parameter a
param forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a v. C a v => Parameter a -> a -> v -> v
scaleWithParamType Parameter a
param a
0.5
{-# INLINE causalComplex #-}
causalComplex ::
(Field.C a, Module.C a v) =>
Parameter a -> Causal.T (Complex.T v) (Complex.T v)
causalComplex :: forall a v. (C a, C a v) => Parameter a -> T (T v) (T v)
causalComplex Parameter a
param =
forall a v. (C a, C a v) => Parameter a -> T (T v) (T v)
causalComplex2 Parameter a
param forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a v. C a v => Parameter a -> a -> v -> v
scaleWithParamType Parameter a
param a
0.5
{-# INLINE runInit2 #-}
runInit2 :: (Ring.C a, Module.C a v) =>
[Complex.T v] -> Parameter a -> Sig.T v -> Sig.T (Complex.T v)
runInit2 :: forall a v. (C a, C a v) => [T v] -> Parameter a -> T v -> [T v]
runInit2 =
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> ctrl -> T a -> T b
Sig.modifyStaticInit forall a v.
(C a, C a v) =>
Initialized [T v] [T v] (Parameter a) v (T v)
modifierInit2
{-# INLINE run2 #-}
run2 :: (Ring.C a, Module.C a v) =>
Parameter a -> Sig.T v -> Sig.T (Complex.T v)
run2 :: forall a v. (C a, C a v) => Parameter a -> T v -> T (T v)
run2 Parameter a
param =
forall a v. (C a, C a v) => [T v] -> Parameter a -> T v -> [T v]
runInit2 (forall a b. [a] -> b -> [b]
Match.replicate (forall a. HasCallStack => a
undefined forall a. a -> [a] -> [a]
: forall a. Parameter a -> [Parameter a]
parameterCosine Parameter a
param) forall a. C a => a
zero) Parameter a
param
lowpassStream ::
(Trans.C a, RealField.C a, Module.C a v) =>
a -> a -> Sig.T v -> Sig.T v
lowpassStream :: forall a v. (C a, C a, C a v) => a -> a -> T v -> T v
lowpassStream a
freq a
cutoff =
let clearLeft :: [T v] -> [T v]
clearLeft = forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply (forall a v. (C a, C a v) => Parameter a -> T (T v) (T v)
causalComplex (forall a. C a => a -> Parameter a
parameter a
freq))
in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => T a -> T v -> v
CM.project
(forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. C a => T a (T a)
Wave.helix forall a. C a => a
zero (a
cutoffforall a. C a => a -> a -> a
/a
freq)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => T a -> T a
Complex.conjugate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[T v] -> [T v]
clearLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map forall a. C a => T a -> T a
Complex.conjugate forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => T a -> T v -> T v
CM.mul
(forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. C a => T a (T a)
Wave.helix forall a. C a => a
zero (-a
2forall a. C a => a -> a -> a
*a
cutoffforall a. C a => a -> a -> a
/a
freq)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[T v] -> [T v]
clearLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => T a -> v -> T v
CM.scale
(forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. C a => T a (T a)
Wave.helix forall a. C a => a
zero (a
cutoffforall a. C a => a -> a -> a
/a
freq))
lowpassMaintainPhase ::
(Trans.C a, RealField.C a, Module.C a v) =>
a -> a -> Sig.T v -> Sig.T v
lowpassMaintainPhase :: forall a v. (C a, C a, C a v) => a -> a -> T v -> T v
lowpassMaintainPhase a
freq a
cutoff =
let clearLeft :: [T v] -> [T v]
clearLeft = forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply (forall a v. (C a, C a v) => Parameter a -> T (T v) (T v)
causalComplex (forall a. C a => a -> Parameter a
parameter a
freq))
in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => T a -> T v -> v
CM.project
(forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. C a => T a (T a)
Wave.helix forall a. C a => a
zero (a
cutoffforall a. C a => a -> a -> a
/a
freq)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[T v] -> [T v]
clearLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => T a -> T v -> T v
CM.mul
(forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. C a => T a (T a)
Wave.helix forall a. C a => a
zero (-a
2forall a. C a => a -> a -> a
*a
cutoffforall a. C a => a -> a -> a
/a
freq)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[T v] -> [T v]
clearLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a v. C a v => T a -> v -> T v
CM.scale
(forall a b. C a => T a b -> a -> a -> T b
Osci.static forall a. C a => T a (T a)
Wave.helix forall a. C a => a
zero (a
cutoffforall a. C a => a -> a -> a
/a
freq))