{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
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,
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}
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
{-# INLINE parameter #-}
parameter :: Trans.C a =>
a
-> a
-> 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)
{-# INLINE parameterAlt #-}
parameterAlt :: Trans.C a =>
a
-> a
-> 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
{-# INLINE parameterApprox #-}
parameterApprox :: Trans.C a =>
a
-> a
-> 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)
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
{-# 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
{-# INLINE cascadeParameter #-}
cascadeParameter :: Trans.C a =>
Int
-> a
-> a
-> 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
{-# 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 =
(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
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
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)
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)
{-# 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)