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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Plain.Filter.Recursive.Allpass (
   Parameter(Parameter, getParameter),
   State,
   cascade,
   cascadeCausal,
   cascadeModifier,
   cascadeParameter,
   cascadeStep,
   cascadeDiverseStep,
   firstOrder,
   firstOrderCausal,
   firstOrderModifier,
   firstOrderStep,
   flangerParameter,
   flangerPhase,
   makePhase,
   parameter,
   parameterApprox,

   -- for testing
   parameterAlt,
   cascadeState,
   cascadeIterative,
   cascadeStepRec,
   cascadeStepScanl,
   cascadeStepStack,
   cascadeCausalModifier,
   cascadeCausalStacked,
   ) where

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 Control.Monad.Trans.State as MS
import qualified Control.Applicative as App

import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import Data.Tuple.HT (mapSnd, )
import Data.Function.HT (nest, )
import Data.List.HT (mapAdjacent, switchR, )

import qualified Foreign.Storable.Newtype as Store
import Foreign.Storable (Storable(sizeOf, alignment, peek, poke))

import qualified Algebra.Module                as Module
import qualified Algebra.RealTranscendental    as RealTrans
import qualified Algebra.Transcendental        as Trans
import qualified Algebra.Field                 as Field
import qualified Algebra.Ring                  as Ring
import qualified Algebra.ZeroTestable          as ZeroTestable

import qualified Number.Complex as Complex

import NumericPrelude.Numeric
import NumericPrelude.Base



newtype Parameter a =
   Parameter {forall a. Parameter a -> a
getParameter :: a}  {- ^ Feedback factor. -}
   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 Functor Parameter where
   {-# INLINE fmap #-}
   fmap :: forall a b. (a -> b) -> Parameter a -> Parameter b
fmap a -> b
f (Parameter a
k) = b -> Parameter b
forall a. a -> Parameter a
Parameter (a -> b
f a
k)

instance App.Applicative Parameter where
   {-# INLINE pure #-}
   pure :: forall a. a -> Parameter a
pure a
x = a -> Parameter a
forall a. a -> Parameter a
Parameter a
x
   {-# INLINE (<*>) #-}
   Parameter a -> b
f <*> :: forall a b. Parameter (a -> b) -> Parameter a -> Parameter b
<*> Parameter a
k =
      b -> Parameter b
forall a. a -> Parameter a
Parameter (a -> b
f a
k)

instance Fold.Foldable Parameter where
   {-# INLINE foldMap #-}
   foldMap :: forall m a. Monoid m => (a -> m) -> Parameter a -> m
foldMap = (a -> m) -> Parameter a -> m
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
k) =
      (a -> Parameter a) -> f a -> f (Parameter a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Parameter a
forall a. a -> Parameter a
Parameter f a
k

instance Interpol.C a v => Interpol.C a (Parameter v) where
   {-# INLINE scaleAndAccumulate #-}
   scaleAndAccumulate :: (a, Parameter v) -> (Parameter v, Parameter v -> Parameter v)
scaleAndAccumulate = (v -> Parameter v)
-> (Parameter v -> v)
-> (a, Parameter v)
-> (Parameter v, Parameter v -> Parameter v)
forall a x v.
C a x =>
(x -> v) -> (v -> x) -> (a, v) -> (v, v -> v)
Interpol.makeMac v -> Parameter v
forall a. a -> Parameter a
Parameter Parameter v -> v
forall a. Parameter a -> a
getParameter

instance Storable a => Storable (Parameter a) where
   sizeOf :: Parameter a -> Int
sizeOf = (Parameter a -> a) -> Parameter a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf Parameter a -> a
forall a. Parameter a -> a
getParameter
   alignment :: Parameter a -> Int
alignment = (Parameter a -> a) -> Parameter a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment Parameter a -> a
forall a. Parameter a -> a
getParameter
   peek :: Ptr (Parameter a) -> IO (Parameter a)
peek = (a -> Parameter a) -> Ptr (Parameter a) -> IO (Parameter a)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek a -> Parameter a
forall a. a -> Parameter a
Parameter
   poke :: Ptr (Parameter a) -> Parameter a -> IO ()
poke = (Parameter a -> a) -> Ptr (Parameter a) -> Parameter a -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke Parameter a -> a
forall a. Parameter a -> a
getParameter


{-
cos phi = (1-r^2)/(1+r^2)
cos omega = (1-s^2)/(1+s^2)
cos (phi-omega)
   = cos phi * cos omega + sin phi * sin omega
   = ((1-r^2)*(1-s^2) + 4*r*s) / ((1+r^2) * (1+s^2))
k = ((1-r^2)*(1+s^2) - (1+r^2)*(1-s^2)) /
    ((1+r^2) * (1+s^2) - ((1-r^2)*(1-s^2) + 4*r*s))
k = 2*(s^2-r^2) / (2*r^2+2*s^2 - 4*r*s)
k = (s^2-r^2) / (r-s)^2
k = (s+r) / (s-r)
-}
{- |
Compute the filter parameter
such that a given phase shift is achieved at a certain frequency.

Both frequency and phase are with respect to unit 1.
This is conform to Phase definition
and allows to avoid Transcendental constraint in some cases
since we need no factor @2*pi@.
See for instance 'parameterApprox'.
However, it is intended that the phase parameter is not of type Phase,
because for the 'cascadeParameter' we divide by the cascade order
and then there is a difference between phase pi and 3*pi.
-}
{-# INLINE parameter #-}
parameter :: Trans.C a =>
     a    {- ^ The phase shift to be achieved for the given frequency. -}
  -> a    {- ^ The frequency we specified the phase shift for. -}
  -> Parameter a
parameter :: forall a. C a => a -> a -> Parameter a
parameter a
phase a
frequency =
   let s :: a
s = a -> a
forall a. C a => a -> a
tan (a
forall a. C a => a
pia -> a -> a
forall a. C a => a -> a -> a
*a
frequency)
       r :: a
r = a -> a
forall a. C a => a -> a
tan (a
forall a. C a => a
pia -> a -> a
forall a. C a => a -> a -> a
*a
phase)
   in  a -> Parameter a
forall a. a -> Parameter a
Parameter (a -> Parameter a) -> a -> Parameter a
forall a b. (a -> b) -> a -> b
$ (a
sa -> a -> a
forall a. C a => a -> a -> a
+a
r) a -> a -> a
forall a. C a => a -> a -> a
/ (a
sa -> a -> a
forall a. C a => a -> a -> a
-a
r)


{- |
This is the same as 'parameter',
but for @phase = frequency@
it has a division of a zero by a zero of multiplicity 2,
whereas 'parameter' has a division  of a non-zero number by zero.
Thus 'parameter' suffers less from cancellation
if @phase@ is close to @frequency@.
-}
{-# INLINE parameterAlt #-}
parameterAlt :: Trans.C a =>
     a    {- ^ The phase shift to be achieved for the given frequency. -}
  -> a    {- ^ The frequency we specified the phase shift for. -}
  -> Parameter a
parameterAlt :: forall a. C a => a -> a -> Parameter a
parameterAlt a
phase a
frequency =
   let omega :: a
omega = a
2a -> a -> a
forall a. C a => a -> a -> a
*a
forall a. C a => a
pi a -> a -> a
forall a. C a => a -> a -> a
* a
frequency
       phi :: a
phi   = a
2a -> a -> a
forall a. C a => a -> a -> a
*a
forall a. C a => a
pi a -> a -> a
forall a. C a => a -> a -> a
* a
phase
       k :: a
k = (a -> a
forall a. C a => a -> a
cos a
phi a -> a -> a
forall a. C a => a -> a -> a
- a -> a
forall a. C a => a -> a
cos a
omega) a -> a -> a
forall a. C a => a -> a -> a
/ (a
1 a -> a -> a
forall a. C a => a -> a -> a
- a -> a
forall a. C a => a -> a
cos (a
phi a -> a -> a
forall a. C a => a -> a -> a
- a
omega))
   in  a -> Parameter a
forall a. a -> Parameter a
Parameter a
k


{- |
An approximation to 'parameter' for small phase and frequency values.
It needs only field operations
due to our choice of the unit 1 for the phase parameter.
-}
{-# INLINE parameterApprox #-}
parameterApprox :: Trans.C a =>
     a    {- ^ The phase shift to be achieved for the given frequency. -}
  -> a    {- ^ The frequency we specified the phase shift for. -}
  -> Parameter a
parameterApprox :: forall a. C a => a -> a -> Parameter a
parameterApprox a
phase a
frequency =
   a -> Parameter a
forall a. a -> Parameter a
Parameter (a -> Parameter a) -> a -> Parameter a
forall a b. (a -> b) -> a -> b
$ (a
frequency a -> a -> a
forall a. C a => a -> a -> a
+ a
phase) a -> a -> a
forall a. C a => a -> a -> a
/ (a
frequency a -> a -> a
forall a. C a => a -> a -> a
- a
phase)


-- * atomic first order allpass

type State v = (v,v)

{-# INLINE firstOrderStep #-}
firstOrderStep :: (Ring.C a, Module.C a v) =>
   Parameter a -> v -> MS.State (State v) v
firstOrderStep :: forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
firstOrderStep (Parameter a
k) v
u0 =
   (State v -> (v, State v)) -> StateT (State v) Identity v
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state (\(v
u1,v
y1) -> let y0 :: v
y0 = v
u1 v -> v -> v
forall a. C a => a -> a -> a
+ a
k a -> v -> v
forall a v. C a v => a -> v -> v
*> (v
u0v -> v -> v
forall a. C a => a -> a -> a
-v
y1) in (v
y0,(v
u0,v
y0)))

{-# INLINE firstOrderModifier #-}
firstOrderModifier :: (Ring.C a, Module.C a v) =>
   Modifier.Simple (State v) (Parameter a) v v
firstOrderModifier :: forall a v. (C a, C a v) => Simple (State v) (Parameter a) v v
firstOrderModifier =
   State v
-> (Parameter a -> v -> State (State v) v)
-> Simple (State v) (Parameter a) v v
forall s ctrl a b.
s -> (ctrl -> a -> State s b) -> Simple s ctrl a b
Modifier.Simple (v
forall a. C a => a
zero,v
forall a. C a => a
zero) Parameter a -> v -> State (State v) v
forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
firstOrderStep

{-# INLINE firstOrderCausal #-}
firstOrderCausal :: (Ring.C a, Module.C a v) =>
   Causal.T (Parameter a, v) v
firstOrderCausal :: forall a v. (C a, C a v) => T (Parameter a, v) v
firstOrderCausal =
   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 Simple (State v) (Parameter a) v v
forall a v. (C a, C a v) => Simple (State v) (Parameter a) v v
firstOrderModifier

{-# INLINE firstOrder #-}
firstOrder :: (Ring.C a, Module.C a v) =>
   Sig.T (Parameter a) -> Sig.T v -> Sig.T v
firstOrder :: forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
firstOrder = Modifier (State v) (Parameter a) v v
-> T (Parameter a) -> T v -> T v
forall s ctrl a b. Modifier s ctrl a b -> T ctrl -> T a -> T b
Sig.modifyModulated Modifier (State v) (Parameter a) v v
forall a v. (C a, C a v) => Simple (State v) (Parameter a) v v
firstOrderModifier


{- |
Compute phase shift of an allpass at a given frequency.
-}
{-# INLINE makePhase #-}
makePhase :: (RealTrans.C a, ZeroTestable.C a) => Parameter a -> a -> a
makePhase :: forall a. (C a, C a) => Parameter a -> a -> a
makePhase (Parameter a
k) a
frequency =
   let cis :: T a
cis = 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
pi a -> a -> a
forall a. C a => a -> a -> a
* a
frequency)
   in  T a -> a
forall a. (C a, C a) => T a -> a
Complex.phase (a -> T a
forall a. C a => a -> T a
Complex.fromReal a
k T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a
cis) a -> a -> a
forall a. C a => a -> a -> a
/ a
forall a. C a => a
pi a -> a -> a
forall a. C a => a -> a -> a
+ a
frequency


-- * allpass cascade with uniform control

{-# INLINE cascadeParameter #-}
cascadeParameter :: Trans.C a =>
     Int  {- ^ The number of equally designed 1st order allpasses. -}
  -> a    {- ^ The phase shift to be achieved for the given frequency. -}
  -> a    {- ^ The frequency we specified the phase shift for. -}
  -> Parameter a
cascadeParameter :: forall a. C a => Int -> a -> a -> Parameter a
cascadeParameter Int
order a
phase =
   a -> a -> Parameter a
forall a. C a => a -> a -> Parameter a
parameter (a
phase a -> a -> a
forall a. C a => a -> a -> a
/ Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
order)

{-# INLINE flangerPhase #-}
flangerPhase :: Field.C a => a
flangerPhase :: forall a. C a => a
flangerPhase = -a
1

{-# INLINE flangerParameter #-}
flangerParameter :: Trans.C a => Int -> a -> Parameter a
flangerParameter :: forall a. C a => Int -> a -> Parameter a
flangerParameter Int
order a
frequency =
   Int -> a -> a -> Parameter a
forall a. C a => Int -> a -> a -> Parameter a
cascadeParameter Int
order a
forall a. C a => a
flangerPhase a
frequency


{-# INLINE cascadeStep #-}
cascadeStep :: (Ring.C a, Module.C a v) =>
   Parameter a -> v -> MS.State [v] v
cascadeStep :: forall a v. (C a, C a v) => Parameter a -> v -> State [v] v
cascadeStep = Parameter a -> v -> State [v] v
forall a v. (C a, C a v) => Parameter a -> v -> State [v] v
cascadeStepRec

{-
internal storage is not very efficient
because the second value of one pair is equal
to the first value of the subsequent value
-}
{-# INLINE cascadeStepStackPairs #-}
cascadeStepStackPairs :: (Ring.C a, Module.C a v) =>
   Parameter a -> v -> MS.State [State v] v
cascadeStepStackPairs :: forall a v. (C a, C a v) => Parameter a -> v -> State [State v] v
cascadeStepStackPairs Parameter a
k =
   -- stackStatesR would work as well, but with reversed list of states
   (v -> State (State v) v) -> v -> State [State v] v
forall a s. (a -> State s a) -> a -> State [s] a
Modifier.stackStatesL (Parameter a -> v -> State (State v) v
forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
firstOrderStep Parameter a
k)

{-# INLINE cascadeStepStack #-}
{-# INLINE cascadeStepRec #-}
{-# INLINE cascadeStepScanl #-}
cascadeStepStack, cascadeStepRec, cascadeStepScanl ::
   (Ring.C a, Module.C a v) =>
   Parameter a -> v -> MS.State [v] v
cascadeStepStack :: forall a v. (C a, C a v) => Parameter a -> v -> State [v] v
cascadeStepStack Parameter a
k v
x =
   ([v] -> (v, [v])) -> StateT [v] Identity v
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state (([v] -> (v, [v])) -> StateT [v] Identity v)
-> ([v] -> (v, [v])) -> StateT [v] Identity v
forall a b. (a -> b) -> a -> b
$
      ([(v, v)] -> [v]) -> (v, [(v, v)]) -> (v, [v])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd [(v, v)] -> [v]
forall a. [(a, a)] -> [a]
fromPairs ((v, [(v, v)]) -> (v, [v]))
-> ([v] -> (v, [(v, v)])) -> [v] -> (v, [v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      State [(v, v)] v -> [(v, v)] -> (v, [(v, v)])
forall s a. State s a -> s -> (a, s)
MS.runState (Parameter a -> v -> State [(v, v)] v
forall a v. (C a, C a v) => Parameter a -> v -> State [State v] v
cascadeStepStackPairs Parameter a
k v
x) ([(v, v)] -> (v, [(v, v)]))
-> ([v] -> [(v, v)]) -> [v] -> (v, [(v, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [v] -> [(v, v)]
forall a. [a] -> [(a, a)]
toPairs

{-# INLINE fromPairs #-}
fromPairs :: [(a,a)] -> [a]
fromPairs :: forall a. [(a, a)] -> [a]
fromPairs xs :: [(a, a)]
xs@((a, a)
x:[(a, a)]
_) = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
xs
fromPairs [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"Allpass.fromPairs: empty list"

{-# INLINE toPairs #-}
toPairs :: [a] -> [(a,a)]
toPairs :: forall a. [a] -> [(a, a)]
toPairs [a]
xs = (a -> a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (,) [a]
xs


cascadeStepRec :: forall a v. (C a, C a v) => Parameter a -> v -> State [v] v
cascadeStepRec (Parameter a
k) v
x = ([v] -> (v, [v])) -> StateT [v] Identity v
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state (([v] -> (v, [v])) -> StateT [v] Identity v)
-> ([v] -> (v, [v])) -> StateT [v] Identity v
forall a b. (a -> b) -> a -> b
$ \[v]
s ->
   let crawl :: a -> [a] -> [a]
crawl a
_ [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"Allpass.crawl needs at least one element in the list"
       crawl a
u0 (a
_:[]) = a
u0a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]
       crawl a
u0 (a
u1:a
y1:[a]
us) =
           let y0 :: a
y0 = a
u1 a -> a -> a
forall a. C a => a -> a -> a
+ a
k a -> a -> a
forall a v. C a v => a -> v -> v
*> (a
u0a -> a -> a
forall a. C a => a -> a -> a
-a
y1)
           in  a
u0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
crawl a
y0 (a
y1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
us)
       news :: [v]
news = v -> [v] -> [v]
forall {a}. C a a => a -> [a] -> [a]
crawl v
x [v]
s
   in  ([v] -> v
forall a. HasCallStack => [a] -> a
last [v]
news, [v]
news)

cascadeStepScanl :: forall a v. (C a, C a v) => Parameter a -> v -> State [v] v
cascadeStepScanl Parameter a
k v
x = ([v] -> (v, [v])) -> StateT [v] Identity v
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state (([v] -> (v, [v])) -> StateT [v] Identity v)
-> ([v] -> (v, [v])) -> StateT [v] Identity v
forall a b. (a -> b) -> a -> b
$ \[v]
s ->
   let news :: [v]
news =
          (v -> State v -> v) -> v -> [State v] -> [v]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
             (State (State v) v -> State v -> v
forall s a. State s a -> s -> a
MS.evalState (State (State v) v -> State v -> v)
-> (v -> State (State v) v) -> v -> State v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameter a -> v -> State (State v) v
forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
firstOrderStep Parameter a
k)
             v
x ((v -> v -> State v) -> [v] -> [State v]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (,) [v]
s)
   in  (v -> ([v] -> v -> v) -> [v] -> v
forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR
           (String -> v
forall a. HasCallStack => String -> a
error String
"Allpass.cascade needs at least one element in the state list")
           ((v -> [v] -> v) -> [v] -> v -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> [v] -> v
forall a b. a -> b -> a
const) [v]
news,
        [v]
news)


{-# INLINE cascadeModifier #-}
cascadeModifier :: (Ring.C a, Module.C a v) =>
   Int -> Modifier.Simple [v] (Parameter a) v v
cascadeModifier :: forall a v. (C a, C a v) => Int -> Simple [v] (Parameter a) v v
cascadeModifier Int
order =
   [v]
-> (Parameter a -> v -> State [v] v)
-> Simple [v] (Parameter a) v v
forall s ctrl a b.
s -> (ctrl -> a -> State s b) -> Simple s ctrl a b
Modifier.Simple (Int -> v -> [v]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
succ Int
order) v
forall a. C a => a
zero) Parameter a -> v -> State [v] v
forall a v. (C a, C a v) => Parameter a -> v -> State [v] v
cascadeStep

{-# INLINE cascadeCausal #-}
{-# INLINE cascadeCausalStacked #-}
{-# INLINE cascadeCausalModifier #-}
cascadeCausal, cascadeCausalStacked, cascadeCausalModifier ::
   (Ring.C a, Module.C a v) =>
   Int -> Causal.T (Parameter a, v) v
cascadeCausal :: forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
cascadeCausal = Int -> T (Parameter a, v) v
forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
cascadeCausalModifier

cascadeCausalStacked :: forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
cascadeCausalStacked Int
order =
   Int -> T (Parameter a, v) v -> T (Parameter a, v) v
forall c x. Int -> T (c, x) x -> T (c, x) x
Causal.replicateControlled Int
order T (Parameter a, v) v
forall a v. (C a, C a v) => T (Parameter a, v) v
firstOrderCausal

cascadeCausalModifier :: forall a v. (C a, C a v) => Int -> T (Parameter a, v) v
cascadeCausalModifier Int
order =
   Simple [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 [v] (Parameter a) v v
forall a v. (C a, C a v) => Int -> Simple [v] (Parameter a) v v
cascadeModifier Int
order)


{-# INLINE cascade #-}
{-# INLINE cascadeState #-}
{-# INLINE cascadeIterative #-}
cascade, cascadeState, cascadeIterative ::
   (Ring.C a, Module.C a v) =>
   Int -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v

{-| Choose one of the implementations below -}
cascade :: forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
cascade = Int -> T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
cascadeState

{-| Simulate the Allpass cascade by a list of states of the partial allpasses -}
cascadeState :: forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
cascadeState Int
order =
   Modifier [v] (Parameter a) v v -> T (Parameter a) -> [v] -> [v]
forall s ctrl a b. Modifier s ctrl a b -> T ctrl -> T a -> T b
Sig.modifyModulated (Int -> Modifier [v] (Parameter a) v v
forall a v. (C a, C a v) => Int -> Simple [v] (Parameter a) v v
cascadeModifier Int
order)

{-| Directly implement the allpass cascade as multiple application of allpasses of 1st order -}
cascadeIterative :: forall a v. (C a, C a v) => Int -> T (Parameter a) -> T v -> T v
cascadeIterative Int
order T (Parameter a)
c =
   Int -> (T v -> T v) -> T v -> T v
forall a. Int -> (a -> a) -> a -> a
nest Int
order (T (Parameter a) -> T v -> T v
forall a v. (C a, C a v) => T (Parameter a) -> T v -> T v
firstOrder T (Parameter a)
c)



-- * allpass cascade with independently controlled atomic allpasses

{-# INLINE cascadeDiverseStep #-}
{-# INLINE cascadeDiverseStepScanl #-}
cascadeDiverseStep, cascadeDiverseStepScanl :: (Ring.C a, Module.C a v) =>
   [Parameter a] -> v -> MS.State [v] v
cascadeDiverseStep :: forall a v. (C a, C a v) => [Parameter a] -> v -> State [v] v
cascadeDiverseStep = [Parameter a] -> v -> State [v] v
forall a v. (C a, C a v) => [Parameter a] -> v -> State [v] v
cascadeDiverseStepScanl

cascadeDiverseStepScanl :: forall a v. (C a, C a v) => [Parameter a] -> v -> State [v] v
cascadeDiverseStepScanl [Parameter a]
ks v
x = ([v] -> (v, [v])) -> StateT [v] Identity v
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state (([v] -> (v, [v])) -> StateT [v] Identity v)
-> ([v] -> (v, [v])) -> StateT [v] Identity v
forall a b. (a -> b) -> a -> b
$ \[v]
s ->
   let news :: [v]
news =
          (v -> (Parameter a, State v) -> v)
-> v -> [(Parameter a, State v)] -> [v]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
             (\v
u0 (Parameter a
k,State v
uy1) -> State (State v) v -> State v -> v
forall s a. State s a -> s -> a
MS.evalState (Parameter a -> v -> State (State v) v
forall a v. (C a, C a v) => Parameter a -> v -> State (State v) v
firstOrderStep Parameter a
k v
u0) State v
uy1)
             v
x ([Parameter a] -> [State v] -> [(Parameter a, State v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Parameter a]
ks ([State v] -> [(Parameter a, State v)])
-> [State v] -> [(Parameter a, State v)]
forall a b. (a -> b) -> a -> b
$ (v -> v -> State v) -> [v] -> [State v]
forall a b. (a -> a -> b) -> [a] -> [b]
mapAdjacent (,) [v]
s)
   in  (v -> ([v] -> v -> v) -> [v] -> v
forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR
           (String -> v
forall a. HasCallStack => String -> a
error String
"Allpass.cascadeDiverse needs at least one element in the state list")
           ((v -> [v] -> v) -> [v] -> v -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> [v] -> v
forall a b. a -> b -> a
const) [v]
news,
        [v]
news)