{-# 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

All recursive filters with real coefficients
can be decomposed into first order and second order filters with real coefficients.
This follows from the Fundamental theorem of algebra.

This implements a cascade of second order filters
using StorableVectors for state and filter parameters.
-}
module Synthesizer.Plain.Filter.Recursive.SecondOrderCascade (
   Parameter (Parameter),
   State,
   step,
   modifierInit,
   modifier,
   causal,
   ) where

import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2
import qualified Synthesizer.Plain.Signal   as Sig
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.Interpolation.Class as Interpol

import qualified Synthesizer.Causal.Process as Causal

import qualified Algebra.Module                as Module
import qualified Algebra.Ring                  as Ring

import qualified Control.Monad.Trans.State as MS

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

import NumericPrelude.Numeric
import NumericPrelude.Base


{-
Maybe there is no need to make the parameter vector
a StorableVector or an Array.
We could also make Paramter a State.Signal,
which reads from a StorableVector or Array buffer.
This way we would not need to create many StorableVectors
when interpolating filter parameters.
-}
newtype Parameter a =
   Parameter (SV.Vector (Filt2.Parameter a))

{-
If Causal.Process would support ST operations,
then we could use a writeable storable vector for the status.
This would save us many allocations.
-}
type State a =
   SV.Vector (Filt2.State a)


{-# INLINE checkSizes #-}
checkSizes :: String -> SV.Vector a -> SV.Vector b -> c -> c
checkSizes :: forall a b c. String -> Vector a -> Vector b -> c -> c
checkSizes String
opName Vector a
x Vector b
y c
act =
   if Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector b -> Int
forall a. Vector a -> Int
SV.length Vector b
y
     then c
act
     else String -> c
forall a. HasCallStack => String -> a
error (String -> c) -> String -> c
forall a b. (a -> b) -> a -> b
$ String
opName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": incompatible sizes of cascades of second order filters"

{-# INLINE withSizeCheck #-}
withSizeCheck ::
   String ->
   (SV.Vector a -> SV.Vector b -> c) ->
   (SV.Vector a -> SV.Vector b -> c)
withSizeCheck :: forall a b c.
String -> (Vector a -> Vector b -> c) -> Vector a -> Vector b -> c
withSizeCheck String
opName Vector a -> Vector b -> c
f Vector a
x Vector b
y =
   String -> Vector a -> Vector b -> c -> c
forall a b c. String -> Vector a -> Vector b -> c -> c
checkSizes String
opName Vector a
x Vector b
y (Vector a -> Vector b -> c
f Vector a
x Vector b
y)


instance (Interpol.C a v, Storable v) => Interpol.C a (Parameter v) where
   {-# INLINE scaleAndAccumulate #-}
   scaleAndAccumulate :: (a, Parameter v) -> (Parameter v, Parameter v -> Parameter v)
scaleAndAccumulate (a
a, Parameter Vector (Parameter v)
x) =
      (Vector (Parameter v) -> Parameter v
forall a. Vector (Parameter a) -> Parameter a
Parameter (Vector (Parameter v) -> Parameter v)
-> Vector (Parameter v) -> Parameter v
forall a b. (a -> b) -> a -> b
$ (Parameter v -> Parameter v)
-> Vector (Parameter v) -> Vector (Parameter v)
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (((a, Parameter v) -> Parameter v)
-> a -> Parameter v -> Parameter v
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, Parameter v) -> Parameter v
forall a v. C a v => (a, v) -> v
Interpol.scale a
a) Vector (Parameter v)
x,
       \ (Parameter Vector (Parameter v)
y) ->
          Vector (Parameter v) -> Parameter v
forall a. Vector (Parameter a) -> Parameter a
Parameter (Vector (Parameter v) -> Parameter v)
-> Vector (Parameter v) -> Parameter v
forall a b. (a -> b) -> a -> b
$ String
-> (Vector (Parameter v)
    -> Vector (Parameter v) -> Vector (Parameter v))
-> Vector (Parameter v)
-> Vector (Parameter v)
-> Vector (Parameter v)
forall a b c.
String -> (Vector a -> Vector b -> c) -> Vector a -> Vector b -> c
withSizeCheck String
"mac"
             ((Parameter v -> Parameter v -> Parameter v)
-> Vector (Parameter v)
-> Vector (Parameter v)
-> Vector (Parameter v)
forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SV.zipWith (((a, Parameter v) -> Parameter v -> Parameter v)
-> a -> Parameter v -> Parameter v -> Parameter v
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, Parameter v) -> Parameter v -> Parameter v
forall a v. C a v => (a, v) -> v -> v
Interpol.scaleAccumulate a
a)) Vector (Parameter v)
x Vector (Parameter v)
y)


{-# INLINE step #-}
step ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Parameter a -> v -> MS.State (State v) v
step :: forall a v.
(C a, C a v, Storable a, Storable v) =>
Parameter a -> v -> State (State v) v
step (Parameter Vector (Parameter a)
p) =
   (Parameter a -> v -> State (State v) v)
-> Vector (Parameter a) -> v -> State (Vector (State v)) v
forall s c a.
(Storable s, Storable c) =>
(c -> a -> State s a) -> Vector c -> a -> State (Vector s) a
Modifier.stackStatesStorableVaryL Parameter a -> v -> State (State v) v
forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
Filt2.step Vector (Parameter a)
p

{-# INLINE modifierInit #-}
modifierInit ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Modifier.Initialized (State v) (State v) (Parameter a) v v
modifierInit :: forall a v.
(C a, C a v, Storable a, Storable v) =>
Initialized (State v) (State v) (Parameter a) v v
modifierInit =
   (State v -> State v)
-> (Parameter a -> v -> State (State v) v)
-> Initialized (State v) (State v) (Parameter a) v v
forall s init ctrl a b.
(init -> s)
-> (ctrl -> a -> State s b) -> Initialized s init ctrl a b
Modifier.Initialized State v -> State v
forall a. a -> a
id Parameter a -> v -> State (State v) v
forall a v.
(C a, C a v, Storable a, Storable v) =>
Parameter a -> v -> State (State v) v
step


{-# INLINE modifier #-}
modifier ::
   (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Modifier.Simple (State v) (Parameter a) v v
modifier :: forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> Simple (State v) (Parameter a) v v
modifier Int
order =
   ModifierInit (State v) (State v) (Parameter a) v v
-> State v -> Modifier (State v) (Parameter a) v v
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Sig.modifierInitialize ModifierInit (State v) (State v) (Parameter a) v v
forall a v.
(C a, C a v, Storable a, Storable v) =>
Initialized (State v) (State v) (Parameter a) v v
modifierInit
      (Int -> State v -> State v
forall a. Storable a => Int -> a -> Vector a
SV.replicate Int
order State v
forall a. C a => State a
Filt2.zeroState)

{-# INLINE causal #-}
causal :: (Ring.C a, Module.C a v, Storable a, Storable v) =>
   Int ->
   Causal.T (Parameter a, v) v
causal :: forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> T (Parameter a, v) v
causal Int
order =
   Simple (State v) (Parameter a) v v -> T (Parameter a, v) v
forall s ctrl a b. Simple s ctrl a b -> T (ctrl, a) b
Causal.fromSimpleModifier (Int -> Simple (State v) (Parameter a) v v
forall a v.
(C a, C a v, Storable a, Storable v) =>
Int -> Simple (State v) (Parameter a) v v
modifier Int
order)