[Haskell-cafe] How to implement a digital filter, using Arrows?

[John Lask]

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