Fix center value of kernel; refactor; add high-pass, band-reject, and band-pass filters.

This commit is contained in:
Jesse D. McDonald 2013-11-11 04:29:54 -06:00
parent 703e4b2531
commit 31e73c0e56
1 changed files with 67 additions and 33 deletions

View File

@ -12,32 +12,44 @@ import Numeric.GSL.Fourier as LA
import Control.Applicative import Control.Applicative
import Data.Complex import Data.Complex
import System.IO
import System.Random import System.Random
import System.Time import System.Time
import Text.Printf import Text.Printf
sample_rate, cutoff :: Double lowPassKernel :: Double -> Double -> Int -> Vector Double
sample_rate = 10000 {-Hz-} lowPassKernel sr fc ksize = raw / V.singleton sum
cutoff = 1000 {-Hz-}
kernel_size :: Int
kernel_size = 101
lowPassKernel :: Vector Double
lowPassKernel = raw / V.singleton sum
where where
n = V.enumFromN 0 kernel_size n = V.enumFromN 0 ksize
t = (n - fromIntegral (kernel_size `div` 2)) / V.singleton sample_rate t = (n - fromIntegral (ksize `div` 2)) / V.singleton sr
-- sinc function; replace division by zero with limit when t=0 -- sinc function; replace division by zero with limit when t=0
sinc' = sin (V.singleton (2*pi*cutoff) * t) / (V.singleton pi * t) sinc' = sin (V.singleton (2*pi*fc) * t) / (V.singleton pi * t)
sinc = sinc' V.// [(kernel_size `div` 2, 2 * pi * cutoff / sample_rate)] sinc = sinc' V.// [(ksize `div` 2, 2 * fc)]
-- Hamming window function -- Hamming window function
kmax = fromIntegral (kernel_size - 1) kmax = fromIntegral (ksize - 1)
hamm = 0.54 - 0.46 * cos (V.singleton (2 * pi / kmax) * n) hamm = 0.54 - 0.46 * cos (V.singleton (2 * pi / kmax) * n)
-- Normalize the result -- Normalize the result
raw = sinc * hamm raw = sinc * hamm
sum = sumElements raw sum = sumElements raw
invertSpectrum :: Vector Double -> Vector Double
invertSpectrum kernel = midVal `seq` (negate kernel V.// [(mid, 1 - midVal)])
where
mid = (dim kernel) `div` 2
midVal = kernel @> mid
highPassKernel :: Double -> Double -> Int -> Vector Double
highPassKernel sr fc ksize =
invertSpectrum $ lowPassKernel sr fc ksize
bandRejectKernel :: Double -> (Double, Double) -> Int -> Vector Double
bandRejectKernel sr (lfc, hfc) ksize =
lowPassKernel sr lfc ksize + highPassKernel sr hfc ksize
bandPassKernel :: Double -> (Double, Double) -> Int -> Vector Double
bandPassKernel sr (lfc, hfc) ksize =
invertSpectrum $ bandRejectKernel sr (lfc, hfc) ksize
-- convolution = integral(kernel(t-tau)*input(tau),tau) -- convolution = integral(kernel(t-tau)*input(tau),tau)
-- t is output vector index (j); products and summation are done with dot product (<.>) -- t is output vector index (j); products and summation are done with dot product (<.>)
convolve :: Vector Double -> Vector Double -> Vector Double convolve :: Vector Double -> Vector Double -> Vector Double
@ -48,18 +60,20 @@ convolve kernel input = V.generate osize $ \j -> rkernel <.> V.slice j ksize inp
osize = isize - ksize osize = isize - ksize
rkernel = V.reverse kernel rkernel = V.reverse kernel
main :: IO () decimate :: Int -> Vector Double -> Vector Double
main = do decimate osize vec =
let isize = 2000000 V.generate osize $ \j ->
seed <- randomIO (sumElements $ V.slice (j * ssize) ssize vec) / fromIntegral ssize
(input, inputTime) <- time $ return $ LA.randomVector seed Gaussian isize where
(_, kernelTime) <- time $ return lowPassKernel vsize = dim vec
(result, resultTime) <- time $ return $ convolve lowPassKernel input ssize = vsize `div` osize
V.mapM_ (printf "%10.6f\n") $ V.slice 0 50 result
--V.mapM_ (printf "%10.6f\n") $ V.map magnitude $ LA.fft $ V.map (:+0) result diffClockTimesSec :: ClockTime -> ClockTime -> Double
printf "Input Time: %8.6f seconds\n" $ inputTime diffClockTimesSec a b = sec + picosec / 1.0e12
printf "Kernel Time: %8.6f seconds\n" $ kernelTime where
printf "Result Time: %8.6f seconds\n" $ resultTime diff = diffClockTimes a b
sec = fromIntegral $ tdSec diff
picosec = fromIntegral $ tdPicosec diff
time :: IO a -> IO (a, Double) time :: IO a -> IO (a, Double)
time f = do time f = do
@ -67,10 +81,30 @@ time f = do
x <- f x <- f
end <- x `seq` getClockTime end <- x `seq` getClockTime
return (x, diffClockTimesSec end start) return (x, diffClockTimesSec end start)
diffClockTimesSec :: ClockTime -> ClockTime -> Double main :: IO ()
diffClockTimesSec a b = sec + picosec / 1.0e12 main = do
where let sample_rate = 10000 {-Hz-} :: Double
diff = diffClockTimes a b let cutoff = 1000 {-Hz-} :: Double
sec = fromIntegral $ tdSec diff
picosec = fromIntegral $ tdPicosec diff let input_size = 1000000 :: Int
let kernel_size = 201 :: Int
seed <- randomIO
(input, inputTime) <- time $ return $ LA.randomVector seed Gaussian input_size
(kernel, kernelTime) <- time $ return $ lowPassKernel sample_rate cutoff kernel_size
(result, resultTime) <- time $ return $ convolve kernel input
--V.mapM_ (printf "%10.6f\n") kernel
--let fft_result = V.map magnitude $ LA.fft $ V.map (:+0) result
--V.mapM_ (printf "%10.6f\n") . decimate 500 . V.take (dim fft_result `div` 2) $ fft_result
V.mapM_ (printf "%10.6f\n") . V.slice 0 50 $ result
hFlush stdout
hPutStrLn stderr $ printf "Input Time: %8.6f seconds" inputTime
hPutStrLn stderr $ printf "Kernel Time: %8.6f seconds" kernelTime
hPutStrLn stderr $ printf "Result Time: %8.6f seconds" resultTime