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

Hi John, Thanks for this reply:
Date: Tue, 18 Oct 2011 14:05:22 +1030 From: John Lask
Subject: Re: [Haskell-cafe] How to implement a digital filter, using Arrows? To: haskell-cafe@haskell.org Message-ID: Content-Type: text/plain; charset="ISO-8859-1"; format=flowed your function corresponds with Control.Arrow.Transformer.Automaton. If you frame your function is such most of your plumbing is taken care of.
Following your advice, I arrived at: 1 {-# LANGUAGE Arrows, GeneralizedNewtypeDeriving, FlexibleContexts #-} 2 3 module Filter ( 4 FilterState 5 , Filter 6 , applyFilter 7 , convT 8 ) where 9 10 import EitherT 11 import Control.Monad 12 import Control.Monad.State 13 import Control.Arrow 14 import Control.Arrow.Operations 15 import Control.Arrow.Transformer 16 import Control.Arrow.Transformer.All 17 import Data.Stream as DS (fromList, toList) 18 19 -- tap weights, `as' and `bs', are being made part of the filter state, in 20 -- order to accomodate adaptive filters (i.e. - DFEs). 21 data FilterState a = FilterState { 22 as :: [a] -- transfer function denominator coefficients 23 , bs :: [a] -- transfer function numerator coefficients 24 , taps :: [a] -- current delay tap stored values 25 } 26 27 -- Future proofing the implementation, using the `newtype' trick. 28 newtype Filter b c = F { 29 runFilter :: (b, FilterState b) -> (c, FilterState b) 31 } 32 33 -- Time domain convolution filter (FIR or IIR), 34 -- expressed in direct form 2 35 convT :: (Num b) => Filter b b 36 convT = F $ \(x, s) -> 37 let wk = (x - sum [a * t | (a, t) <- zip (tail $ as s) (taps s)]) 38 newTaps = wk : ((reverse . tail . reverse) $ taps s) 39 s' = s {taps = newTaps} 40 y = sum [b * w | (b, w) <- zip (bs s) (wk : (taps s))] 41 in (y, s') 42 43 -- Turn a filter into an Automaton, in order to use the built in plubming 44 -- of Arrows to run the filter on an input. 45 filterAuto :: (ArrowApply a) => Filter b c -> FilterState b -> Automaton a (e, b) c 46 filterAuto f s = Automaton a where 47 a = proc (e, x) -> do 48 (y, s') <- arr (runFilter f) -< (x, s) 49 returnA -< (y, filterAuto f s') 50 53 applyFilter :: Filter b c -> FilterState b -> [b] -> ([c], FilterState b) 54 applyFilter f s = 55 let a = filterAuto f s 56 in proc xs -> do 57 ys <- runAutomaton a -< ((), DS.fromList xs) 58 s' <- (|fetch|) 59 returnA -< (DS.toList ys, s') 60 which gave me this compile error:
Filter.hs:58:16: Could not deduce (ArrowState (FilterState b) (->)) from the context () arising from a use of `fetch' at Filter.hs:58:16-20 Possible fix: add (ArrowState (FilterState b) (->)) to the context of the type signature for `applyFilter' or add an instance declaration for (ArrowState (FilterState b) (->)) In the expression: fetch In the expression: proc xs -> do { ys <- runAutomaton a -< ((), fromList xs); s' <- (|fetch |); returnA -< (toList ys, s') } In the expression: let a = filterAuto f s in proc xs -> do { ys <- runAutomaton a -< ((), fromList xs); s' <- (|fetch |); .... }
So, I made this change: 51 applyFilter :: *(ArrowState (FilterState b) (->)) =>* Filter b c -> FilterState b -> [b] -> 52 ([c], FilterState b) And that compiled. However, when I tried to test my new filter with:
let s = FilterState [1,0,0] [0.7, 0.2, 0.1] [0, 0, 0] applyFilter convT s [1,0,0,0,0]
I got:
<interactive>:1:0: No instance for (ArrowState (FilterState Double) (->)) arising from a use of `applyFilter' at <interactive>:1:0-30 Possible fix: add an instance declaration for (ArrowState (FilterState Double) (->)) In the expression: applyFilter convT s [1, 0, 0, 0, ....] In the definition of `it': it = applyFilter convT s [1, 0, 0, ....]
I thought, "maybe, I need to derive from *ArrowState* in my *Filter* type definition." So, I tried making this change to the code: 28 newtype Filter b c = F { 29 runFilter :: (b, FilterState b) -> (c, FilterState b) 30 } deriving (ArrowState (FilterState x)) but then I was back to no compile:
Filter.hs:30:14: Can't make a derived instance of `ArrowState (FilterState x) Filter' (even with cunning newtype deriving): cannot eta-reduce the representation type enough In the newtype declaration for `Filter'
Do you have any advice? Thanks, -db

Your type stopped being an arrow when the state type started to depend on
the input type:
Filter a b ~= (a, FS a) -> (b, FS a)
Filter b c ~= (b, FS b) -> (c, FS b)
It's impossible to compose these two functions into a single function of
type Filter a c, because the state type doesn't match.
You need to make the filter state not dependent on the input type:
newtype Filter s a b = F { runFilter :: (a, FilterState s) -> (b,
FilterState s) }
You can still create objects with the type
Filter a a b
which correspond to your old filter type. But these functions will always
'start' a pipeline. Which I think is what you want anyways!
-- ryan
On Tue, Oct 18, 2011 at 2:35 PM, Captain Freako
Hi John, Thanks for this reply:
Date: Tue, 18 Oct 2011 14:05:22 +1030 From: John Lask
Subject: Re: [Haskell-cafe] How to implement a digital filter, using Arrows? To: haskell-cafe@haskell.org Message-ID: Content-Type: text/plain; charset="ISO-8859-1"; format=flowed your function corresponds with Control.Arrow.Transformer.Automaton. If you frame your function is such most of your plumbing is taken care of.
Following your advice, I arrived at:
1 {-# LANGUAGE Arrows, GeneralizedNewtypeDeriving, FlexibleContexts #-} 2 3 module Filter ( 4 FilterState 5 , Filter 6 , applyFilter 7 , convT 8 ) where 9 10 import EitherT 11 import Control.Monad 12 import Control.Monad.State 13 import Control.Arrow 14 import Control.Arrow.Operations 15 import Control.Arrow.Transformer 16 import Control.Arrow.Transformer.All 17 import Data.Stream as DS (fromList, toList) 18 19 -- tap weights, `as' and `bs', are being made part of the filter state, in 20 -- order to accomodate adaptive filters (i.e. - DFEs). 21 data FilterState a = FilterState { 22 as :: [a] -- transfer function denominator coefficients 23 , bs :: [a] -- transfer function numerator coefficients 24 , taps :: [a] -- current delay tap stored values 25 } 26 27 -- Future proofing the implementation, using the `newtype' trick. 28 newtype Filter b c = F { 29 runFilter :: (b, FilterState b) -> (c, FilterState b) 31 } 32 33 -- Time domain convolution filter (FIR or IIR), 34 -- expressed in direct form 2 35 convT :: (Num b) => Filter b b 36 convT = F $ \(x, s) -> 37 let wk = (x - sum [a * t | (a, t) <- zip (tail $ as s) (taps s)]) 38 newTaps = wk : ((reverse . tail . reverse) $ taps s) 39 s' = s {taps = newTaps} 40 y = sum [b * w | (b, w) <- zip (bs s) (wk : (taps s))] 41 in (y, s') 42 43 -- Turn a filter into an Automaton, in order to use the built in plubming 44 -- of Arrows to run the filter on an input. 45 filterAuto :: (ArrowApply a) => Filter b c -> FilterState b -> Automaton a (e, b) c 46 filterAuto f s = Automaton a where 47 a = proc (e, x) -> do 48 (y, s') <- arr (runFilter f) -< (x, s) 49 returnA -< (y, filterAuto f s') 50 53 applyFilter :: Filter b c -> FilterState b -> [b] -> ([c], FilterState b) 54 applyFilter f s = 55 let a = filterAuto f s 56 in proc xs -> do 57 ys <- runAutomaton a -< ((), DS.fromList xs) 58 s' <- (|fetch|) 59 returnA -< (DS.toList ys, s') 60
which gave me this compile error:
Filter.hs:58:16: Could not deduce (ArrowState (FilterState b) (->)) from the context () arising from a use of `fetch' at Filter.hs:58:16-20 Possible fix: add (ArrowState (FilterState b) (->)) to the context of the type signature for `applyFilter' or add an instance declaration for (ArrowState (FilterState b) (->)) In the expression: fetch In the expression: proc xs -> do { ys <- runAutomaton a -< ((), fromList xs); s' <- (|fetch |); returnA -< (toList ys, s') } In the expression: let a = filterAuto f s in proc xs -> do { ys <- runAutomaton a -< ((), fromList xs); s' <- (|fetch |); .... }
So, I made this change:
51 applyFilter :: *(ArrowState (FilterState b) (->)) =>* Filter b c -> FilterState b -> [b] -> 52 ([c], FilterState b)
And that compiled. However, when I tried to test my new filter with:
let s = FilterState [1,0,0] [0.7, 0.2, 0.1] [0, 0, 0] applyFilter convT s [1,0,0,0,0]
I got:
<interactive>:1:0: No instance for (ArrowState (FilterState Double) (->)) arising from a use of `applyFilter' at <interactive>:1:0-30 Possible fix: add an instance declaration for (ArrowState (FilterState Double) (->)) In the expression: applyFilter convT s [1, 0, 0, 0, ....] In the definition of `it': it = applyFilter convT s [1, 0, 0, ....]
I thought, "maybe, I need to derive from *ArrowState* in my *Filter* type definition." So, I tried making this change to the code:
28 newtype Filter b c = F { 29 runFilter :: (b, FilterState b) -> (c, FilterState b) 30 } deriving (ArrowState (FilterState x))
but then I was back to no compile:
Filter.hs:30:14: Can't make a derived instance of `ArrowState (FilterState x) Filter' (even with cunning newtype deriving): cannot eta-reduce the representation type enough In the newtype declaration for `Filter'
Do you have any advice?
Thanks, -db
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

{-# 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]
participants (3)
-
Captain Freako
-
John Lask
-
Ryan Ingram