> {-# 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]
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
