{-# LANGUAGE Arrows #-}
This is literate code. It expounds on your initial question and provides two solutions based either on the StateArrow or Automaton....
module Test where import Data.List ( mapAccumL ) import Control.Arrow import Control.Arrow.Operations import Control.Arrow.Transformer import Control.Arrow.Transformer.State import Control.Arrow.Transformer.Automaton
this later formulation corresponds to Control.Arrow.Transformer.State
data FilterState a = FilterState { as :: [a] -- transfer function denominator coefficients , bs :: [a] -- transfer function numerator coefficients , taps :: [a] -- current delay tap stored values }
-- Time domain convolution filter (FIR or IIR), -- expressed in direct form 2 convT = \(x, s) -> let wk = (x - sum [a * t | (a, t)<- zip (tail $ as s) (taps s)]) newTaps = wk : ((reverse . tail . reverse) $ taps s) s' = s {taps = newTaps} y = sum [b * w | (b, w)<- zip (bs s) (wk : (taps s))] in (y, s')
we can construct the type of a Filter as a state arrow with state (FilterState s) and base arrow type of (->)
type FilterSt s b c = StateArrow (FilterState s) (->) b c
to lift the function convT to a state arrow it would be very easy if the constructor were exported (ie. ST convT), however it is not. So we define a custom "lift" to lift functions of the above type into the arrow
liftSt :: ((x,FilterState s)->(y,FilterState s)) -> FilterSt s x y liftSt f = proc x -> do s <- fetch -< () (y,s') <- arr f -< (x,s) store -< s' returnA -< y
then to fold the arrow over a list of inputs
runFilterSt :: FilterSt s b c -> (FilterState s) -> [b] -> (FilterState s , [c]) runFilterSt f = mapAccumL (curry (swap . runState f . swap)) where swap (a,b) = (b,a)
t1 = let s = FilterState [1,0,0] [0.7, 0.2, 0.1] [0, 0, 0] in snd $ runFilterSt (liftSt convT) s [1,0,0,0,0]
*Test> t1 [0.7,0.2,0.1,0.0,0.0] except I am not sure you want a state arrow as that propogates the state through all arrows. eg in a >>> b, the state modified by a passes to b and so on. This would only be any good if all your filters shared/modified the same state. the initial suggestion was to use an automaton arrow which isolates the state in each arrow.
type FilterAu b c = Automaton (->) b c
liftAu :: ((x,FilterState s)->(y,FilterState s)) -> FilterState s -> FilterAu x y liftAu f s0 = proc x -> do rec (y,s') <- arr f -< (x,s) s <- delay s0 -< s' returnA -< y
runAutomaton is a bit cumbersome, so define a custom run function that takes a list
runAuto a [] = [] runAuto (Automaton f) (x:xs) = let (y,a) = f x in y:runAuto a xs
t2 = let s = FilterState [1,0,0] [0.7, 0.2, 0.1] [0, 0, 0] in runAuto (liftAu convT s) [1,0,0,0,0]
*Test> t2 [0.7,0.2,0.1,0.0,0.0]