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

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

Chebyshev lowpass and highpass
-}
module Synthesizer.Plain.Filter.Recursive.Chebyshev (
   ParameterA, parameterA, partialParameterA,
   ParameterB, parameterB, partialParameterB,
   canonicalizeParameterA,
   causalA, runAPole, causalAPole,
   causalB, runBPole, causalBPole,
   lowpassACausalPole, highpassACausalPole,
   lowpassBCausalPole, highpassBCausalPole,
   lowpassAPole, highpassAPole,
   lowpassBPole, highpassBPole,
   -- used in LLVM.Filter.Chebyshev
   makeCirclePoints,
   ) where

import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass), Pole(Pole, poleResonance))
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrderCascade as Cascade
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2
import qualified Synthesizer.Plain.Signal   as Sig
import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow ((>>>), (^>>), (&&&), )

import qualified Algebra.Module                as Module
import qualified Algebra.Transcendental        as Trans
import qualified Algebra.Field                 as Field
import qualified Algebra.Ring                  as Ring

import Number.Complex (real, imag, cis, )
import qualified Number.Complex as Complex

import qualified Data.StorableVector as SV
import Foreign.Storable (Storable)

import NumericPrelude.Numeric
import NumericPrelude.Base




circleList, circleListSlow, _circleListFast :: (Trans.C a) => a -> [Complex.T a]
circleList :: forall a. C a => a -> [T a]
circleList = a -> [T a]
forall a. C a => a -> [T a]
circleListSlow

circleListSlow :: forall a. C a => a -> [T a]
circleListSlow a
x =
   (a -> T a) -> [a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map a -> T a
forall a. C a => a -> T a
cis ([a] -> [T a]) -> [a] -> [T a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> a -> a
forall a. C a => a -> a -> a
*) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
2a -> a -> a
forall a. C a => a -> a -> a
+) a
1

_circleListFast :: forall a. C a => a -> [T a]
_circleListFast a
x =
   let z1 :: T a
z1 = a -> T a
forall a. C a => a -> T a
cis a
x
       z2 :: T a
z2 = T a
z1T a -> Integer -> T a
forall a. C a => a -> Integer -> a
^Integer
2
   in  (T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (T a
z2T a -> T a -> T a
forall a. C a => a -> a -> a
*) T a
z1


makeCirclePoints :: (Trans.C a) => Int -> [Complex.T a]
makeCirclePoints :: forall a. C a => Int -> [T a]
makeCirclePoints Int
order =
   Int -> [T a] -> [T a]
forall a. Int -> [a] -> [a]
take Int
order (a -> [T a]
forall a. C a => a -> [T a]
circleList (a
forall a. C a => a
pi a -> a -> a
forall a. C a => a -> a -> a
/ (a
4 a -> a -> a
forall a. C a => a -> a -> a
* Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
order)))

-- | compute the partial filter of the second order from the pole information
{-
It's worth to think it over whether this routine could be used for the Butterworth filter.
But whereas this function is specialized to the zeros of the denominator polynomial
for the Butterworth filter the quadratic factors of the polynomial can be determined
more efficiently than the zeros.
-}
partialLowpassParameterA, partialLowpassParameterB :: (Trans.C a) =>
   Int -> a -> a -> Complex.T a -> Filt2.Parameter a
{-
partialLowpassParameterA order ratio freq =
   let {- if ratio == (sqrt 2) then the product of the normalization factors is
          2^(1-2*order) -}
--       bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
       bn = (log(1+ratio) - log(1-ratio^2)/2) / fromIntegral (2*order)
       coshbn = cosh bn
       sinhbn = sinh bn

       phi     = pi*freq
       sinphi  = sin phi
       cosphi  = cos phi
       sinphi2 = sinphi^2

   in  \c ->
          let re      =   real c * coshbn; re2 = re^2
              im      = - imag c * sinhbn; im2 = im^2
              cpims   = cosphi + im*sinphi
              cmims   = cosphi - im*sinphi
              resin2  = re2*sinphi2
              denom   = - cmims^2 - resin2
              vol     = sqrt ((1-re2-im2)^2 + 4*im2)
              c0      = vol * sinphi2 / denom
          in  Filt2.Parameter
                 c0 (2*c0) c0
                 (-2*(cpims*cmims - resin2)/denom) ((cpims^2 + resin2)/denom)
-}

partialLowpassParameterA :: forall a. C a => Int -> a -> a -> T a -> Parameter a
partialLowpassParameterA Int
order a
ratio a
freq =
   let {- if ratio == (sqrt 2) then the product of the normalization factors is
          2^(1-2*order) -}
--       bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
       bn :: a
bn = (a -> a
forall a. C a => a -> a
log(a
1a -> a -> a
forall a. C a => a -> a -> a
+a
ratio) a -> a -> a
forall a. C a => a -> a -> a
- a -> a
forall a. C a => a -> a
log(a
1a -> a -> a
forall a. C a => a -> a -> a
-a
ratioa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2)a -> a -> a
forall a. C a => a -> a -> a
/a
2) a -> a -> a
forall a. C a => a -> a -> a
/ Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*Int
order)
       coshbn :: a
coshbn = a -> a
forall a. C a => a -> a
cosh a
bn
       sinhbn :: a
sinhbn = a -> a
forall a. C a => a -> a
sinh a
bn
--       cosh2bn = (cosh(2*bn)-1)/2 = sinhbn2
       coshbn2 :: a
coshbn2 = a
coshbna -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2
       sinhbn2 :: a
sinhbn2 = a
sinhbna -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2

       phi :: a
phi     = a
forall a. C a => a
pia -> a -> a
forall a. C a => a -> a -> a
*a
freq
       sinphi :: a
sinphi  = a -> a
forall a. C a => a -> a
sin a
phi
       cosphi :: a
cosphi  = a -> a
forall a. C a => a -> a
cos a
phi
       sinphi2 :: a
sinphi2 = a
sinphia -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2

       sinhbnsinphi :: a
sinhbnsinphi   = a
sinhbna -> a -> a
forall a. C a => a -> a -> a
*a
sinphi
--       sinhbn2sinphi2 = sinhbn2*sinphi2
       coshbn2sinphi2 :: a
coshbn2sinphi2 = a
coshbn2a -> a -> a
forall a. C a => a -> a -> a
*a
sinphi2

   in  \T a
c ->
          let re :: a
re      = T a -> a
forall a. T a -> a
real T a
c
              im :: a
im      = T a -> a
forall a. T a -> a
imag T a
c
              imss :: a
imss    = a
im a -> a -> a
forall a. C a => a -> a -> a
* a
sinhbnsinphi
              cpims :: a
cpims   = a
cosphi a -> a -> a
forall a. C a => a -> a -> a
- a
imss
              cmims :: a
cmims   = a
cosphi a -> a -> a
forall a. C a => a -> a -> a
+ a
imss
              resin2 :: a
resin2  = a
rea -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
* a
coshbn2sinphi2
              denom :: a
denom   = - a
cmimsa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
- a
resin2
              c0 :: a
c0      = (a
ima -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
+ a
sinhbn2)a -> a -> a
forall a. C a => a -> a -> a
*a
sinphi2 a -> a -> a
forall a. C a => a -> a -> a
/ a
denom
          in  a -> a -> a -> a -> a -> Parameter a
forall a. a -> a -> a -> a -> a -> Parameter a
Filt2.Parameter
                 a
c0 (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
c0) a
c0
                 (-a
2a -> a -> a
forall a. C a => a -> a -> a
*(a
cpimsa -> a -> a
forall a. C a => a -> a -> a
*a
cmims a -> a -> a
forall a. C a => a -> a -> a
- a
resin2)a -> a -> a
forall a. C a => a -> a -> a
/a
denom) ((a
cpimsa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
+ a
resin2)a -> a -> a
forall a. C a => a -> a -> a
/a
denom)

{-
partialLowpassParameterA order ratio freq =
   let {- if ratio == (sqrt 2) then the product of the normalization factors is
          2^(1-2*order) -}
       bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
       sinhbnd = 2 * sinh bn
       cosh2bn = (cosh(2*bn)-1)/2

       phi       = pi*freq
       sinphi    = sin phi
       cosphi    = cos phi
       sinphi2   = sinphi^2
--       cosphi2   = cosphi^2
       sincosphi = sinphi*cosphi

   in  \c ->
          let imd     = - imag c * sinhbnd
              re2pim2 = cosh2bn + real c ^ 2
              ri2sp2  = (re2pim2-1)*sinphi2
              cpims2  = 1 + ri2sp2 + imd*sincosphi
              cmims2  = 1 + ri2sp2 - imd*sincosphi
              cpmims  = 1 - (re2pim2+1)*sinphi2
              denom   = - cmims2
              vol     = sqrt (ri2sp2^2 + (imd*sinphi2)^2)
              c0      = vol / denom
          in  Filt2.Parameter
                 c0 (2*c0) c0
                 (-2*cpmims/denom) (cpims2/denom)
-}

{-
partialLowpassParameterA order ratio freq =
   let {- if ratio == (sqrt 2) then the product of the normalization factors is
          2^(1-2*order) -}
       bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
       coshbn = cosh bn
       sinhbn = sinh bn

       phi       = pi*freq
       sinphi    = sin phi
       cosphi    = cos phi
       sinphi2   = sinphi^2
--       cosphi2   = cosphi^2
       sincosphi = sinphi*cosphi

   in  \c ->
          let re      =   real c * coshbn; re2 = re^2
              im      = - imag c * sinhbn; im2 = im^2
              re2pim2 = re2+im2
              cpims2  = 1 + (re2pim2-1)*sinphi2 + 2*im*sincosphi
              cmims2  = 1 + (re2pim2-1)*sinphi2 - 2*im*sincosphi
              cpmims  = 1 - (re2pim2+1)*sinphi2
              denom   = - cmims2
              vol     = sqrt ((re2pim2-1)^2 + 4*im2)
              c0      = vol * sinphi2 / denom
          in  Filt2.Parameter
                 c0 (2*c0) c0
                 (-2*cpmims/denom) (cpims2/denom)
-}

{-
partialLowpassParameterB order ratio freq =
   let -- bn = asinh (sqrt(1-ratio^2)/ratio) / fromIntegral (2*order)
       bn = (log(1+sqrt(1-ratio^2)) - log ratio) / fromIntegral (2*order)
       coshbn  = cosh bn
       sinhbn  = sinh bn
       coshbn2 = coshbn^2

       phi     = pi*freq
       sinphi  = sin phi
       cosphi  = cos phi
       sinphi2 = sinphi^2
       cosphi2 = cosphi^2

   in  \c ->
          let re      =   real c * coshbn
              im      = - imag c * sinhbn
              spimc   = sinphi + im*cosphi
              smimc   = sinphi - im*cosphi
              recos2  = re^2 * cosphi2
              denom   = smimc^2 + recos2
              a02cosphi2 = real c ^ 2 * cosphi2
              c0      = (sinphi2 + a02cosphi2) / denom
              c1      = (sinphi2 - a02cosphi2) / denom
          in  Filt2.Parameter
                 c0 (2*c1) c0
                 (-2*(spimc*smimc - recos2)/denom) (-(spimc^2 + recos2)/denom)
-}

partialLowpassParameterB :: forall a. C a => Int -> a -> a -> T a -> Parameter a
partialLowpassParameterB Int
order a
ratio a
freq =
   let -- bn = asinh (sqrt(1-ratio^2)/ratio) / fromIntegral (2*order)
       bn :: a
bn = (a -> a
forall a. C a => a -> a
log(a
1a -> a -> a
forall a. C a => a -> a -> a
+a -> a
forall a. C a => a -> a
sqrt(a
1a -> a -> a
forall a. C a => a -> a -> a
-a
ratioa -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2)) a -> a -> a
forall a. C a => a -> a -> a
- a -> a
forall a. C a => a -> a
log a
ratio) a -> a -> a
forall a. C a => a -> a -> a
/ Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*Int
order)
       coshbn :: a
coshbn  = a -> a
forall a. C a => a -> a
cosh a
bn
       sinhbn :: a
sinhbn  = a -> a
forall a. C a => a -> a
sinh a
bn
       coshbn2 :: a
coshbn2 = a
coshbna -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2

       phi :: a
phi     = a
forall a. C a => a
pia -> a -> a
forall a. C a => a -> a -> a
*a
freq
       sinphi :: a
sinphi  = a -> a
forall a. C a => a -> a
sin a
phi
       cosphi :: a
cosphi  = a -> a
forall a. C a => a -> a
cos a
phi
       sinphi2 :: a
sinphi2 = a
sinphia -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2
       cosphi2 :: a
cosphi2 = a
cosphia -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2

       sinhbncosphi :: a
sinhbncosphi = a
sinhbna -> a -> a
forall a. C a => a -> a -> a
*a
cosphi

   in  \T a
c ->
          let a02cosphi2 :: a
a02cosphi2 = T a -> a
forall a. T a -> a
real T a
c a -> Integer -> a
forall a. C a => a -> Integer -> a
^ Integer
2 a -> a -> a
forall a. C a => a -> a -> a
* a
cosphi2
              imsc :: a
imsc    = T a -> a
forall a. T a -> a
imag T a
c a -> a -> a
forall a. C a => a -> a -> a
* a
sinhbncosphi
              spimc :: a
spimc   = a
sinphi a -> a -> a
forall a. C a => a -> a -> a
- a
imsc
              smimc :: a
smimc   = a
sinphi a -> a -> a
forall a. C a => a -> a -> a
+ a
imsc
              recos2 :: a
recos2  = a
a02cosphi2 a -> a -> a
forall a. C a => a -> a -> a
* a
coshbn2
              denom :: a
denom   = a
smimca -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
+ a
recos2
              c0 :: a
c0      = (a
sinphi2 a -> a -> a
forall a. C a => a -> a -> a
+ a
a02cosphi2) a -> a -> a
forall a. C a => a -> a -> a
/ a
denom
              c1 :: a
c1      = (a
sinphi2 a -> a -> a
forall a. C a => a -> a -> a
- a
a02cosphi2) a -> a -> a
forall a. C a => a -> a -> a
/ a
denom
          in  a -> a -> a -> a -> a -> Parameter a
forall a. a -> a -> a -> a -> a -> Parameter a
Filt2.Parameter
                 a
c0 (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
c1) a
c0
                 (-a
2a -> a -> a
forall a. C a => a -> a -> a
*(a
spimca -> a -> a
forall a. C a => a -> a -> a
*a
smimc a -> a -> a
forall a. C a => a -> a -> a
- a
recos2)a -> a -> a
forall a. C a => a -> a -> a
/a
denom) (-(a
spimca -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
2 a -> a -> a
forall a. C a => a -> a -> a
+ a
recos2)a -> a -> a
forall a. C a => a -> a -> a
/a
denom)


-- * use second order filter parameters for control

{-# INLINE partialParameter #-}
partialParameter ::
   (Field.C a) =>
   (a -> a -> Complex.T a -> Filt2.Parameter a) ->
   Passband -> a -> Complex.T a -> a -> Filt2.Parameter a
partialParameter :: forall a.
C a =>
(a -> a -> T a -> Parameter a)
-> Passband -> a -> T a -> a -> Parameter a
partialParameter a -> a -> T a -> Parameter a
lowpassParameter Passband
kind a
ratio T a
c a
freq =
   Passband -> (a -> Parameter a) -> a -> Parameter a
forall a. C a => Passband -> (a -> Parameter a) -> a -> Parameter a
Filt2.adjustPassband Passband
kind
      ((a -> T a -> Parameter a) -> T a -> a -> Parameter a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a -> T a -> Parameter a
lowpassParameter a
ratio) T a
c)
      a
freq

{-# INLINE partialParameterA #-}
{-# INLINE partialParameterB #-}
partialParameterA, partialParameterB ::
   (Trans.C a) =>
   Passband -> Int -> a -> Complex.T a -> a -> Filt2.Parameter a
partialParameterA :: forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterA Passband
kind Int
order =
   (a -> a -> T a -> Parameter a)
-> Passband -> a -> T a -> a -> Parameter a
forall a.
C a =>
(a -> a -> T a -> Parameter a)
-> Passband -> a -> T a -> a -> Parameter a
partialParameter (Int -> a -> a -> T a -> Parameter a
forall a. C a => Int -> a -> a -> T a -> Parameter a
partialLowpassParameterA Int
order) Passband
kind
partialParameterB :: forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterB Passband
kind Int
order =
   (a -> a -> T a -> Parameter a)
-> Passband -> a -> T a -> a -> Parameter a
forall a.
C a =>
(a -> a -> T a -> Parameter a)
-> Passband -> a -> T a -> a -> Parameter a
partialParameter (Int -> a -> a -> T a -> Parameter a
forall a. C a => Int -> a -> a -> T a -> Parameter a
partialLowpassParameterB Int
order) Passband
kind

{-
We could prevent definition of an extra parameter type
by applying application to one of the filters using Filt2.amplify.
-}
type ParameterA a = (a, Cascade.Parameter a)

{-# INLINE parameterA #-}
parameterA ::
   (Trans.C a, Storable a) =>
   Passband -> Int -> Pole a -> ParameterA a
parameterA :: forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> ParameterA a
parameterA Passband
kind Int
order =
   -- I hope that the 'let' is floated out of a 'map'
   let circleVec :: Vector (T a)
circleVec = [T a] -> Vector (T a)
forall a. Storable a => [a] -> Vector a
SV.pack (Int -> [T a]
forall a. C a => Int -> [T a]
makeCirclePoints Int
order)
   in  \ (Pole a
ratio a
freq) ->
          (a
ratio,
           Vector (Parameter a) -> Parameter a
forall a. Vector (Parameter a) -> Parameter a
Cascade.Parameter (Vector (Parameter a) -> Parameter a)
-> Vector (Parameter a) -> Parameter a
forall a b. (a -> b) -> a -> b
$
           (T a -> Parameter a) -> Vector (T a) -> Vector (Parameter a)
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (\T a
c -> Passband -> Int -> a -> T a -> a -> Parameter a
forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterA Passband
kind Int
order a
ratio T a
c a
freq) (Vector (T a) -> Vector (Parameter a))
-> Vector (T a) -> Vector (Parameter a)
forall a b. (a -> b) -> a -> b
$
           Vector (T a)
circleVec)

{-# INLINE canonicalizeParameterA #-}
canonicalizeParameterA ::
   (Ring.C a, Storable a) =>
   ParameterA a -> Cascade.Parameter a
canonicalizeParameterA :: forall a. (C a, Storable a) => ParameterA a -> Parameter a
canonicalizeParameterA (a
amp, Cascade.Parameter Vector (Parameter a)
p) =
   Vector (Parameter a) -> Parameter a
forall a. Vector (Parameter a) -> Parameter a
Cascade.Parameter
      (Vector (Parameter a)
-> (Parameter a -> Vector (Parameter a) -> Vector (Parameter a))
-> Vector (Parameter a)
-> Vector (Parameter a)
forall a b.
Storable a =>
b -> (a -> Vector a -> b) -> Vector a -> b
SV.switchL Vector (Parameter a)
forall a. Storable a => Vector a
SV.empty (\Parameter a
h -> Parameter a -> Vector (Parameter a) -> Vector (Parameter a)
forall a. Storable a => a -> Vector a -> Vector a
SV.cons (a -> Parameter a -> Parameter a
forall a. C a => a -> Parameter a -> Parameter a
Filt2.amplify a
amp Parameter a
h)) Vector (Parameter a)
p)


type ParameterB a = Cascade.Parameter a

{-# INLINE parameterB #-}
parameterB ::
   (Trans.C a, Storable a) =>
   Passband -> Int -> Pole a -> ParameterB a
parameterB :: forall a.
(C a, Storable a) =>
Passband -> Int -> Pole a -> ParameterB a
parameterB Passband
kind Int
order =
   -- I hope that the 'let' is floated out of a 'map'
   let circleVec :: Vector (T a)
circleVec = [T a] -> Vector (T a)
forall a. Storable a => [a] -> Vector a
SV.pack (Int -> [T a]
forall a. C a => Int -> [T a]
makeCirclePoints Int
order)
   in  \ (Pole a
ratio a
freq) ->
           Vector (Parameter a) -> ParameterB a
forall a. Vector (Parameter a) -> Parameter a
Cascade.Parameter (Vector (Parameter a) -> ParameterB a)
-> Vector (Parameter a) -> ParameterB a
forall a b. (a -> b) -> a -> b
$
           (T a -> Parameter a) -> Vector (T a) -> Vector (Parameter a)
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (\T a
c -> Passband -> Int -> a -> T a -> a -> Parameter a
forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterB Passband
kind Int
order a
ratio T a
c a
freq) (Vector (T a) -> Vector (Parameter a))
-> Vector (T a) -> Vector (Parameter a)
forall a b. (a -> b) -> a -> b
$
           Vector (T a)
circleVec

{-
{-# INLINE modifierB #-}
modifierB ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Modifier.Simple (Cascade.State v) (Cascade.Parameter a) v v
modifierB =
   Cascade.modifierB
-}

{-# INLINE causalA #-}
causalA :: (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Causal.T (ParameterA a, v) v
causalA :: forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> T (ParameterA a, v) v
causalA Int
order =
   ((ParameterA a, v) -> Parameter a)
-> T (ParameterA a, v) (Parameter a)
forall a b. (a -> b) -> T a b
Causal.map (ParameterA a -> Parameter a
forall a b. (a, b) -> b
snd(ParameterA a -> Parameter a)
-> ((ParameterA a, v) -> ParameterA a)
-> (ParameterA a, v)
-> Parameter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ParameterA a, v) -> ParameterA a
forall a b. (a, b) -> a
fst) T (ParameterA a, v) (Parameter a)
-> T (ParameterA a, v) v -> T (ParameterA a, v) (Parameter a, v)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((ParameterA a, v) -> v) -> T (ParameterA a, v) v
forall a b. (a -> b) -> T a b
Causal.map (\((a
ratio,Parameter a
_), v
y) -> a
ratio a -> v -> v
forall a v. C a v => a -> v -> v
*> v
y)
    T (ParameterA a, v) (Parameter a, v)
-> T (Parameter a, v) v -> T (ParameterA a, v) v
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> T (Parameter a, v) v
forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> T (Parameter a, v) v
Cascade.causal Int
order

{-# INLINE causalB #-}
causalB :: (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Causal.T (ParameterB a, v) v
causalB :: forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> T (Parameter a, v) v
causalB =
   Int -> T (Parameter a, v) v
forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> T (Parameter a, v) v
Cascade.causal




-- * directly use frequency as control parameter

runAPole, runBPole :: (Trans.C a, Module.C a v) =>
   Passband -> Int -> Sig.T a -> Sig.T a -> Sig.T v -> Sig.T v
runAPole :: forall a v.
(C a, C a v) =>
Passband -> Int -> T a -> T a -> T v -> T v
runAPole Passband
kind Int
order T a
ratios T a
freqs =
   let makePartialFilter :: T a -> T v -> T v
makePartialFilter T a
c =
          T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt2.run
             ((a -> a -> Parameter a) -> T a -> T a -> T (Parameter a)
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                 (\a
ratio a
freq -> Passband -> Int -> a -> T a -> a -> Parameter a
forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterA Passband
kind Int
order a
ratio T a
c a
freq)
                 T a
ratios T a
freqs)
   in  ((T v -> T v) -> (T v -> T v) -> T v -> T v)
-> (T v -> T v) -> [T v -> T v] -> T v -> T v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (T v -> T v) -> (T v -> T v) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((a -> v -> v) -> T a -> T v -> T v
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> v -> v
forall a v. C a v => a -> v -> v
(*>) T a
ratios)
          ((T a -> T v -> T v) -> [T a] -> [T v -> T v]
forall a b. (a -> b) -> [a] -> [b]
map T a -> T v -> T v
forall {v}. C a v => T a -> T v -> T v
makePartialFilter (Int -> [T a]
forall a. C a => Int -> [T a]
makeCirclePoints Int
order))

runBPole :: forall a v.
(C a, C a v) =>
Passband -> Int -> T a -> T a -> T v -> T v
runBPole Passband
kind Int
order T a
ratios T a
freqs =
   let makePartialFilter :: T a -> T v -> T v
makePartialFilter T a
c =
          T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
Filt2.run
             ((a -> a -> Parameter a) -> T a -> T a -> T (Parameter a)
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                 (\a
ratio a
freq -> Passband -> Int -> a -> T a -> a -> Parameter a
forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterB Passband
kind Int
order a
ratio T a
c a
freq)
                 T a
ratios T a
freqs)
   in  ((T v -> T v) -> (T v -> T v) -> T v -> T v)
-> (T v -> T v) -> [T v -> T v] -> T v -> T v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (T v -> T v) -> (T v -> T v) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) T v -> T v
forall a. a -> a
id ((T a -> T v -> T v) -> [T a] -> [T v -> T v]
forall a b. (a -> b) -> [a] -> [b]
map T a -> T v -> T v
forall {v}. C a v => T a -> T v -> T v
makePartialFilter (Int -> [T a]
forall a. C a => Int -> [T a]
makeCirclePoints Int
order))


causalAPole, causalBPole :: (Trans.C a, Module.C a v) =>
   Passband -> Int -> Causal.T (Pole a, v) v
causalAPole :: forall a v. (C a, C a v) => Passband -> Int -> T (Pole a, v) v
causalAPole Passband
kind Int
order =
   let {-# INLINE makePartialFilter #-}
       makePartialFilter :: T a -> T (Pole a, c) c
makePartialFilter T a
c =
          T (Pole a) (Parameter a) -> T (Pole a, c) (Parameter a, c)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Causal.first ((Pole a -> Parameter a) -> T (Pole a) (Parameter a)
forall a b. (a -> b) -> T a b
Causal.map (\(Pole a
ratio a
freq) ->
             Passband -> Int -> a -> T a -> a -> Parameter a
forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterA Passband
kind Int
order a
ratio T a
c a
freq)) T (Pole a, c) (Parameter a, c)
-> T (Parameter a, c) c -> T (Pole a, c) c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          T (Parameter a, c) c
forall a v. (C a, C a v) => T (Parameter a, v) v
Filt2.causal
   in  (\(Pole a
p, v
y) -> (Pole a
p, Pole a -> a
forall a. Pole a -> a
poleResonance Pole a
p a -> v -> v
forall a v. C a v => a -> v -> v
*> v
y)) ((Pole a, v) -> (Pole a, v)) -> T (Pole a, v) v -> T (Pole a, v) v
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>>
       ([T (Pole a, v) v] -> T (Pole a, v) v
forall c x. [T (c, x) x] -> T (c, x) x
Causal.chainControlled ([T (Pole a, v) v] -> T (Pole a, v) v)
-> [T (Pole a, v) v] -> T (Pole a, v) v
forall a b. (a -> b) -> a -> b
$
        (T a -> T (Pole a, v) v) -> [T a] -> [T (Pole a, v) v]
forall a b. (a -> b) -> [a] -> [b]
map T a -> T (Pole a, v) v
forall {a} {c}. (C a, C a c) => T a -> T (Pole a, c) c
makePartialFilter ([T a] -> [T (Pole a, v) v]) -> [T a] -> [T (Pole a, v) v]
forall a b. (a -> b) -> a -> b
$
        Int -> [T a]
forall a. C a => Int -> [T a]
makeCirclePoints Int
order)

causalBPole :: forall a v. (C a, C a v) => Passband -> Int -> T (Pole a, v) v
causalBPole Passband
kind Int
order =
   let {-# INLINE makePartialFilter #-}
       makePartialFilter :: T a -> T (Pole a, c) c
makePartialFilter T a
c =
          T (Pole a) (Parameter a) -> T (Pole a, c) (Parameter a, c)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Causal.first ((Pole a -> Parameter a) -> T (Pole a) (Parameter a)
forall a b. (a -> b) -> T a b
Causal.map (\(Pole a
ratio a
freq) ->
             Passband -> Int -> a -> T a -> a -> Parameter a
forall a. C a => Passband -> Int -> a -> T a -> a -> Parameter a
partialParameterB Passband
kind Int
order a
ratio T a
c a
freq)) T (Pole a, c) (Parameter a, c)
-> T (Parameter a, c) c -> T (Pole a, c) c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          T (Parameter a, c) c
forall a v. (C a, C a v) => T (Parameter a, v) v
Filt2.causal
   in  [T (Pole a, v) v] -> T (Pole a, v) v
forall c x. [T (c, x) x] -> T (c, x) x
Causal.chainControlled ([T (Pole a, v) v] -> T (Pole a, v) v)
-> [T (Pole a, v) v] -> T (Pole a, v) v
forall a b. (a -> b) -> a -> b
$
       (T a -> T (Pole a, v) v) -> [T a] -> [T (Pole a, v) v]
forall a b. (a -> b) -> [a] -> [b]
map T a -> T (Pole a, v) v
forall {a} {c}. (C a, C a c) => T a -> T (Pole a, c) c
makePartialFilter ([T a] -> [T (Pole a, v) v]) -> [T a] -> [T (Pole a, v) v]
forall a b. (a -> b) -> a -> b
$
       Int -> [T a]
forall a. C a => Int -> [T a]
makeCirclePoints Int
order


lowpassACausalPole, highpassACausalPole,
 lowpassBCausalPole, highpassBCausalPole ::
   (Trans.C a, Module.C a v) =>
   Int -> Causal.T (Pole a, v) v
lowpassACausalPole :: forall a v. (C a, C a v) => Int -> T (Pole a, v) v
lowpassACausalPole  = Passband -> Int -> T (Pole a, v) v
forall a v. (C a, C a v) => Passband -> Int -> T (Pole a, v) v
causalAPole Passband
Lowpass
highpassACausalPole :: forall a v. (C a, C a v) => Int -> T (Pole a, v) v
highpassACausalPole = Passband -> Int -> T (Pole a, v) v
forall a v. (C a, C a v) => Passband -> Int -> T (Pole a, v) v
causalAPole Passband
Highpass

lowpassBCausalPole :: forall a v. (C a, C a v) => Int -> T (Pole a, v) v
lowpassBCausalPole  = Passband -> Int -> T (Pole a, v) v
forall a v. (C a, C a v) => Passband -> Int -> T (Pole a, v) v
causalBPole Passband
Lowpass
highpassBCausalPole :: forall a v. (C a, C a v) => Int -> T (Pole a, v) v
highpassBCausalPole = Passband -> Int -> T (Pole a, v) v
forall a v. (C a, C a v) => Passband -> Int -> T (Pole a, v) v
causalBPole Passband
Highpass


lowpassAPole, highpassAPole, lowpassBPole, highpassBPole ::
   (Trans.C a, Module.C a v) =>
   Int -> Sig.T a -> Sig.T a -> Sig.T v -> Sig.T v
lowpassAPole :: forall a v. (C a, C a v) => Int -> T a -> T a -> T v -> T v
lowpassAPole  = Passband -> Int -> T a -> T a -> T v -> T v
forall a v.
(C a, C a v) =>
Passband -> Int -> T a -> T a -> T v -> T v
runAPole Passband
Lowpass
highpassAPole :: forall a v. (C a, C a v) => Int -> T a -> T a -> T v -> T v
highpassAPole = Passband -> Int -> T a -> T a -> T v -> T v
forall a v.
(C a, C a v) =>
Passband -> Int -> T a -> T a -> T v -> T v
runAPole Passband
Highpass

lowpassBPole :: forall a v. (C a, C a v) => Int -> T a -> T a -> T v -> T v
lowpassBPole  = Passband -> Int -> T a -> T a -> T v -> T v
forall a v.
(C a, C a v) =>
Passband -> Int -> T a -> T a -> T v -> T v
runBPole Passband
Lowpass
highpassBPole :: forall a v. (C a, C a v) => Int -> T a -> T a -> T v -> T v
highpassBPole = Passband -> Int -> T a -> T a -> T v -> T v
forall a v.
(C a, C a v) =>
Passband -> Int -> T a -> T a -> T v -> T v
runBPole Passband
Highpass