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