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

Wed Oct 19 02:28:00 CEST 2011

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

```