[Haskell-cafe] Request for optimizing help.
Captain Freako
capn.freako at gmail.com
Sun Jun 24 16:13:42 CEST 2012
Does anyone have any advice for optimizing the code, below?
Currently, the profiling results look like this:
COST CENTRE MODULE %time %alloc
runFilter Filter 90.9 41.0
convT Filter 9.1 58.6
Thanks for any help!
-db
11 data FilterState a = FilterState {
12 as :: [a] -- transfer function denominator coefficients
13 , bs :: [a] -- transfer function numerator coefficients
14 , taps :: [a] -- current delay tap stored values
15 } deriving (Show)
16
17 type Kernel a = (a, FilterState a) -> (a, FilterState a)
18
19 -- FILTER KERNELS
20 -- Time domain convolution filter (FIR or IIR),
21 -- expressed in direct form 2
22 convT :: (Fractional a) => Kernel a
23 convT (x, s) =
24 let wk = (x - sum [a * t | (a, t) <- zip (tail $ as s) (taps s)]) /
head (as s)
25 newTaps = wk : init (taps s)
26 s' = s {taps = newTaps}
27 y = sum [b * w | (b, w) <- zip (bs s) (wk : taps s)]
28 in (y, s')
29
30 -- FILTER APPLICATION
31 runFilter :: Kernel a -> FilterState a -> [a] -> IO ([a], FilterState a)
32 runFilter f s0 [] = do
33 return ([], s0)
34 runFilter f s0 (x:xs) = do
35 (y, s') <- return (f (x, s0))
36 (ys, s) <- runFilter f s' xs
37 return (y:ys, s)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120624/c0cd1dcc/attachment.htm>
More information about the Haskell-Cafe
mailing list