[Haskell-cafe] How to implement a digital filter, using Arrows?
Captain Freako
capn.freako at gmail.com
Tue Oct 18 23:35:03 CEST 2011
Hi John,
Thanks for this reply:
> Date: Tue, 18 Oct 2011 14:05:22 +1030
> From: John Lask <jvlask at hotmail.com>
> Subject: Re: [Haskell-cafe] How to implement a digital filter, using
> Arrows?
> To: haskell-cafe at haskell.org
> Message-ID: <BLU0-
> SMTP384394452FD2750FBE3BCFCC6E50 at phx.gbl>
> 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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20111018/eff02eee/attachment.htm>
More information about the Haskell-Cafe
mailing list