{-# LANGUAGE RecordWildCards, FlexibleContexts, GADTs, ExistentialQuantification #-}
module SDR.Filter (
Filter(..),
Decimator(..),
Resampler(..),
haskellFilter,
fastFilterCR,
fastFilterSSER,
fastFilterAVXR,
fastFilterR,
fastFilterCC,
fastFilterSSEC,
fastFilterAVXC,
fastFilterC,
fastFilterSymSSER,
fastFilterSymAVXR,
fastFilterSymR,
haskellDecimator,
fastDecimatorCR,
fastDecimatorSSER,
fastDecimatorAVXR,
fastDecimatorR,
fastDecimatorCC,
fastDecimatorSSEC,
fastDecimatorAVXC,
fastDecimatorC,
fastDecimatorSymSSER,
fastDecimatorSymAVXR,
fastDecimatorSymR,
haskellResampler,
fastResamplerCR,
fastResamplerSSER,
fastResamplerAVXR,
fastResamplerR,
fastResamplerCC,
fastResamplerSSEC,
fastResamplerAVXC,
fastResamplerC,
firFilter,
firDecimator,
firResampler,
dcBlockingFilter
) where
import Control.Applicative
import Data.Complex
import Control.Exception hiding (assert)
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Storable as VS
import Control.Monad.Primitive
import Pipes
import SDR.Util
import SDR.FilterInternal hiding (mkResampler, mkResamplerC)
import SDR.CPUID
data Filter m v vm a = Filter {
numCoeffsF :: Int,
filterOne :: Int -> v a -> vm (PrimState m) a -> m (),
filterCross :: Int -> v a -> v a -> vm (PrimState m) a -> m ()
}
data Decimator m v vm a = Decimator {
numCoeffsD :: Int,
decimationD :: Int,
decimateOne :: Int -> v a -> vm (PrimState m) a -> m (),
decimateCross :: Int -> v a -> v a -> vm (PrimState m) a -> m ()
}
data Resampler m v vm a = forall dat. Resampler {
numCoeffsR :: Int,
decimationR :: Int,
interpolationR :: Int,
startDat :: dat,
resampleOne :: dat -> Int -> v a -> vm (PrimState m) a -> m (dat, Int),
resampleCross :: dat -> Int -> v a -> v a -> vm (PrimState m) a -> m (dat, Int)
}
duplicate :: [a] -> [a]
duplicate = concatMap func
where func x = [x, x]
{-# INLINE haskellFilter #-}
haskellFilter :: (PrimMonad m, Functor m, Num a, Mult a b, VG.Vector v a, VG.Vector v b, VGM.MVector vm a)
=> [b]
-> IO (Filter m v vm a)
haskellFilter coeffs = do
let vCoeffs = VG.fromList coeffs
evaluate vCoeffs
let filterOne = filterHighLevel vCoeffs
filterCross = filterCrossHighLevel vCoeffs
numCoeffsF = length coeffs
return Filter {..}
mkFilter :: Int
-> FilterRR
-> [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
mkFilter sizeMultiple filterFunc coeffs = do
let l = length coeffs
numCoeffsF = roundUp l sizeMultiple
diff = numCoeffsF - l
vCoeffs = VG.fromList $ coeffs ++ replicate diff 0
evaluate vCoeffs
let filterOne = filterFunc vCoeffs
filterCross = filterCrossHighLevel vCoeffs
return Filter {..}
fastFilterCR :: [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterCR = mkFilter 1 filterCRR
fastFilterSSER :: [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterSSER = mkFilter 4 filterCSSERR
fastFilterAVXR :: [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterAVXR = mkFilter 8 filterCAVXRR
fastFilterR :: CPUInfo
-> [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterR info = featureSelect info fastFilterCR [(hasAVX, fastFilterAVXR), (hasSSE42, fastFilterSSER)]
mkFilterC :: Int
-> FilterRC
-> [Float]
-> IO (Filter IO VS.Vector VS.MVector (Complex Float))
mkFilterC sizeMultiple filterFunc coeffs = do
let l = length coeffs
numCoeffsF = roundUp sizeMultiple l
diff = numCoeffsF - l
vCoeffs = VG.fromList $ duplicate $ coeffs ++ replicate diff 0
vCoeffs2 = VG.fromList $ coeffs ++ replicate diff 0
evaluate vCoeffs
let filterOne = filterFunc vCoeffs
filterCross = filterCrossHighLevel vCoeffs2
return Filter {..}
fastFilterCC :: [Float]
-> IO (Filter IO VS.Vector VS.MVector (Complex Float))
fastFilterCC = mkFilterC 1 filterCRC
fastFilterSSEC :: [Float]
-> IO (Filter IO VS.Vector VS.MVector (Complex Float))
fastFilterSSEC = mkFilterC 2 filterCSSERC
fastFilterAVXC :: [Float]
-> IO (Filter IO VS.Vector VS.MVector (Complex Float))
fastFilterAVXC = mkFilterC 4 filterCAVXRC
fastFilterC :: CPUInfo
-> [Float]
-> IO (Filter IO VS.Vector VS.MVector (Complex Float))
fastFilterC info = featureSelect info fastFilterCC [(hasAVX, fastFilterAVXC), (hasSSE42, fastFilterSSEC)]
mkFilterSymR :: FilterRR
-> [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
mkFilterSymR filterFunc coeffs = do
let vCoeffs = VG.fromList coeffs
let vCoeffs2 = VG.fromList $ coeffs ++ reverse coeffs
evaluate vCoeffs
evaluate vCoeffs2
let filterOne = filterFunc vCoeffs
filterCross = filterCrossHighLevel vCoeffs2
numCoeffsF = length coeffs * 2
return Filter {..}
fastFilterSymSSER :: [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterSymSSER = mkFilterSymR filterCSSESymmetricRR
fastFilterSymAVXR :: [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterSymAVXR = mkFilterSymR filterCAVXSymmetricRR
fastFilterSymR :: CPUInfo
-> [Float]
-> IO (Filter IO VS.Vector VS.MVector Float)
fastFilterSymR info = featureSelect info (error "At least SSE4.2 required") [(hasAVX, fastFilterSymAVXR), (hasSSE42, fastFilterSymSSER)]
{-# INLINE haskellDecimator #-}
haskellDecimator :: (PrimMonad m, Functor m, Num a, Mult a b, VG.Vector v a, VG.Vector v b, VGM.MVector vm a)
=> Int
-> [b]
-> IO (Decimator m v vm a)
haskellDecimator decimationD coeffs = do
let vCoeffs = VG.fromList coeffs
evaluate vCoeffs
let decimateOne = decimateHighLevel decimationD vCoeffs
decimateCross = decimateCrossHighLevel decimationD vCoeffs
numCoeffsD = length coeffs
return $ Decimator {..}
mkDecimator :: Int
-> DecimateRR
-> Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
mkDecimator sizeMultiple filterFunc decimationD coeffs = do
let l = length coeffs
numCoeffsD = roundUp l sizeMultiple
diff = numCoeffsD - l
vCoeffs = VG.fromList $ coeffs ++ replicate diff 0
evaluate vCoeffs
let decimateOne = filterFunc decimationD vCoeffs
decimateCross = decimateCrossHighLevel decimationD vCoeffs
return Decimator {..}
fastDecimatorCR :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorCR = mkDecimator 1 decimateCRR
fastDecimatorSSER :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorSSER = mkDecimator 4 decimateCSSERR
fastDecimatorAVXR :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorAVXR = mkDecimator 8 decimateCAVXRR
fastDecimatorR :: CPUInfo
-> Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorR info = featureSelect info fastDecimatorCR [(hasAVX, fastDecimatorAVXR), (hasSSE42, fastDecimatorSSER)]
mkDecimatorC :: Int
-> DecimateRC
-> Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector (Complex Float))
mkDecimatorC sizeMultiple filterFunc decimationD coeffs = do
let l = length coeffs
numCoeffsD = roundUp l sizeMultiple
diff = numCoeffsD - l
vCoeffs = VG.fromList $ duplicate $ coeffs ++ replicate diff 0
vCoeffs2 = VG.fromList $ coeffs ++ replicate diff 0
evaluate vCoeffs
let decimateOne = filterFunc decimationD vCoeffs
decimateCross = decimateCrossHighLevel decimationD vCoeffs2
return Decimator {..}
fastDecimatorCC :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector (Complex Float))
fastDecimatorCC = mkDecimatorC 1 decimateCRC
fastDecimatorSSEC :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector (Complex Float))
fastDecimatorSSEC = mkDecimatorC 2 decimateCSSERC
fastDecimatorAVXC :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector (Complex Float))
fastDecimatorAVXC = mkDecimatorC 4 decimateCAVXRC
fastDecimatorC :: CPUInfo
-> Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector (Complex Float))
fastDecimatorC info = featureSelect info fastDecimatorCC [(hasAVX, fastDecimatorAVXC), (hasSSE42, fastDecimatorSSEC)]
mkDecimatorSymR :: DecimateRR
-> Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
mkDecimatorSymR filterFunc decimationD coeffs = do
let vCoeffs = VG.fromList coeffs
let vCoeffs2 = VG.fromList $ coeffs ++ reverse coeffs
evaluate vCoeffs
evaluate vCoeffs2
let decimateOne = filterFunc decimationD vCoeffs
decimateCross = decimateCrossHighLevel decimationD vCoeffs2
numCoeffsD = length coeffs * 2
return Decimator {..}
fastDecimatorSymSSER :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorSymSSER = mkDecimatorSymR decimateCSSESymmetricRR
fastDecimatorSymAVXR :: Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorSymAVXR = mkDecimatorSymR decimateCAVXSymmetricRR
fastDecimatorSymR :: CPUInfo
-> Int
-> [Float]
-> IO (Decimator IO VS.Vector VS.MVector Float)
fastDecimatorSymR info = featureSelect info (error "at least AVX required") [(hasAVX, fastDecimatorSymAVXR), (hasSSE42, fastDecimatorSymSSER)]
{-# INLINE haskellResampler #-}
haskellResampler :: (PrimMonad m, Functor m, Num a, Mult a b, VG.Vector v a, VG.Vector v b, VGM.MVector vm a)
=> Int
-> Int
-> [b]
-> IO (Resampler m v vm a)
haskellResampler interpolationR decimationR coeffs = do
let vCoeffs = VG.fromList coeffs
evaluate vCoeffs
let resampleOne v w x y = func <$> resampleHighLevel interpolationR decimationR vCoeffs v w x y
resampleCross v w x y z = func <$> resampleCrossHighLevel interpolationR decimationR vCoeffs v w x y z
numCoeffsR = length coeffs
func x = (x, x)
startDat = 0
return Resampler {..}
mkResampler :: Int
-> ResampleRR
-> Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector Float)
mkResampler sizeMultiple filterFunc interpolationR decimationR coeffs = do
let vCoeffs = VG.fromList coeffs
evaluate vCoeffs
resamp <- filterFunc interpolationR decimationR coeffs
let resampleOne v w x y = func1 <$> resamp (fst v) w x y
resampleCross (group, offset) count x y z = do
offset' <- resampleCrossHighLevel interpolationR decimationR vCoeffs offset count x y z
return (((group + count) `mod` interpolationR, offset'), offset')
numCoeffsR = roundUp (length coeffs) (interpolationR * sizeMultiple)
func1 group = let offset = interpolationR - 1 - ((interpolationR + group * decimationR - 1) `mod` interpolationR) in ((group, offset), offset)
startDat = (0, 0)
return Resampler {..}
mkResamplerC :: Int
-> ResampleRC
-> Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector (Complex Float))
mkResamplerC sizeMultiple filterFunc interpolationR decimationR coeffs = do
let vCoeffs = VG.fromList coeffs
evaluate vCoeffs
resamp <- filterFunc interpolationR decimationR coeffs
let resampleOne v w x y = func1 <$> resamp (fst v) w x y
resampleCross (group, offset) count x y z = do
offset' <- resampleCrossHighLevel interpolationR decimationR vCoeffs offset count x y z
return (((group + count) `mod` interpolationR, offset'), offset')
numCoeffsR = roundUp (length coeffs) (interpolationR * sizeMultiple)
func1 group = let offset = interpolationR - 1 - ((interpolationR + group * decimationR - 1) `mod` interpolationR) in ((group, offset), offset)
startDat = (0, 0)
return Resampler {..}
fastResamplerCR :: Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector Float)
fastResamplerCR = mkResampler 1 resampleCRR2
fastResamplerSSER :: Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector Float)
fastResamplerSSER = mkResampler 4 resampleCSSERR
fastResamplerAVXR :: Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector Float)
fastResamplerAVXR = mkResampler 8 resampleCAVXRR
fastResamplerR :: CPUInfo
-> Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector Float)
fastResamplerR info = featureSelect info fastResamplerCR [(hasAVX, fastResamplerAVXR), (hasSSE42, fastResamplerSSER)]
fastResamplerCC :: Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector (Complex Float))
fastResamplerCC = mkResamplerC 1 resampleCRC
fastResamplerSSEC :: Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector (Complex Float))
fastResamplerSSEC = mkResamplerC 4 resampleCSSERC
fastResamplerAVXC :: Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector (Complex Float))
fastResamplerAVXC = mkResamplerC 8 resampleCAVXRC
fastResamplerC :: CPUInfo
-> Int
-> Int
-> [Float]
-> IO (Resampler IO VS.Vector VS.MVector (Complex Float))
fastResamplerC info = featureSelect info fastResamplerCC [(hasAVX, fastResamplerAVXC), (hasSSE42, fastResamplerSSEC)]
data Buffer v a = Buffer {
buffer :: v a,
offset :: Int
}
space Buffer{..} = VGM.length buffer - offset
newBuffer :: (PrimMonad m, VGM.MVector vm a) => Int -> m (Buffer (vm (PrimState m)) a)
newBuffer size = do
buf <- VGM.new size
return $ Buffer buf 0
advanceOutBuf :: (PrimMonad m, VG.Vector v a) => Int -> Buffer (VG.Mutable v (PrimState m)) a -> Int -> Pipe b (v a) m (Buffer (VG.Mutable v (PrimState m)) a)
advanceOutBuf blockSizeOut buf@(Buffer bufOut offsetOut) count =
if count == space buf then do
bufOutF <- lift $ VG.unsafeFreeze bufOut
yield bufOutF
lift $ newBuffer blockSizeOut
else
return $ Buffer bufOut (offsetOut + count)
assert loc False = error loc
assert loc True = return ()
{-# INLINE firFilter #-}
firFilter :: (PrimMonad m, Functor m, VG.Vector v a, Num a)
=> Filter m v (VG.Mutable v) a
-> Int
-> Pipe (v a) (v a) m ()
firFilter Filter{..} blockSizeOut = do
inBuf <- await
outBuf <- lift $ newBuffer blockSizeOut
simple inBuf outBuf
where
simple bufIn bufferOut@(Buffer bufOut offsetOut) = do
assert "filter 1" (VG.length bufIn >= numCoeffsF)
let count = min (VG.length bufIn - numCoeffsF + 1) (space bufferOut)
lift $ filterOne count bufIn (VGM.unsafeDrop offsetOut bufOut)
bufferOut' <- advanceOutBuf blockSizeOut bufferOut count
let bufIn' = VG.drop count bufIn
case VG.length bufIn' < numCoeffsF of
False -> simple bufIn' bufferOut'
True -> do
next <- await
crossover bufIn' next bufferOut'
crossover bufLast bufNext bufferOut@(Buffer bufOut offsetOut) = do
assert "filter 2" (VG.length bufLast < numCoeffsF)
assert "filter 3" (VG.length bufLast > 0)
let count = min (VG.length bufLast) (space bufferOut)
lift $ filterCross count bufLast bufNext (VGM.unsafeDrop offsetOut bufOut)
bufferOut' <- advanceOutBuf blockSizeOut bufferOut count
case VG.length bufLast == count of
True -> simple bufNext bufferOut'
False -> crossover (VG.drop count bufLast) bufNext bufferOut'
{-# INLINE firDecimator #-}
firDecimator :: (PrimMonad m, Functor m, VG.Vector v a, Num a)
=> Decimator m v (VG.Mutable v) a
-> Int
-> Pipe (v a) (v a) m ()
firDecimator Decimator{..} blockSizeOut = do
inBuf <- await
outBuf <- lift $ newBuffer blockSizeOut
simple inBuf outBuf
where
simple bufIn bufferOut@(Buffer bufOut offsetOut) = do
assert "decimate 1" (VG.length bufIn >= numCoeffsD)
let count = min (((VG.length bufIn - numCoeffsD) `quot` decimationD) + 1) (space bufferOut)
lift $ decimateOne count bufIn (VGM.unsafeDrop offsetOut bufOut)
bufferOut' <- advanceOutBuf blockSizeOut bufferOut count
let bufIn' = VG.drop (count * decimationD) bufIn
case VG.length bufIn' < numCoeffsD of
False -> simple bufIn' bufferOut'
True -> do
next <- await
crossover bufIn' next bufferOut'
crossover bufLast bufNext bufferOut@(Buffer bufOut offsetOut) = do
assert "decimate 2" (VG.length bufLast < numCoeffsD)
assert "decimate 3" (VG.length bufLast > 0)
let count = min (VG.length bufLast `quotUp` decimationD) (space bufferOut)
lift $ decimateCross count bufLast bufNext (VGM.unsafeDrop offsetOut bufOut)
bufferOut' <- advanceOutBuf blockSizeOut bufferOut count
case VG.length bufLast <= count * decimationD of
True -> simple (VG.drop (count * decimationD - VG.length bufLast) bufNext) bufferOut'
False -> crossover (VG.drop (count * decimationD) bufLast) bufNext bufferOut'
quotUp q d = (q + (d - 1)) `quot` d
{-# INLINE firResampler #-}
firResampler :: (PrimMonad m, VG.Vector v a, Num a)
=> Resampler m v (VG.Mutable v) a
-> Int
-> Pipe (v a) (v a) m ()
firResampler Resampler{..} blockSizeOut = do
inBuf <- await
outBuf <- lift $ newBuffer blockSizeOut
simple inBuf outBuf startDat 0
where
simple bufIn bufferOut@(Buffer bufOut offsetOut) dat filterOffset = do
assert "resample 1" (VG.length bufIn * interpolationR >= numCoeffsR - filterOffset)
let count = min (((VG.length bufIn * interpolationR - numCoeffsR + filterOffset) `quot` decimationR) + 1) (space bufferOut)
(dat, endOffset) <- lift $ resampleOne dat count bufIn (VGM.unsafeDrop offsetOut bufOut)
assert "resample 2" ((count * decimationR + endOffset - filterOffset) `rem` interpolationR == 0)
bufferOut' <- advanceOutBuf blockSizeOut bufferOut count
let usedInput = (count * decimationR - filterOffset) `quotUp` interpolationR
bufIn' = VG.drop usedInput bufIn
case VG.length bufIn' * interpolationR < numCoeffsR - endOffset of
False -> simple bufIn' bufferOut' dat endOffset
True -> do
next <- await
case VG.length bufIn' == 0 of
True -> simple next bufferOut' dat endOffset
False -> crossover bufIn' next bufferOut' dat endOffset
crossover bufLast bufNext bufferOut@(Buffer bufOut offsetOut) dat filterOffset = do
assert "resample 3" (VG.length bufLast * interpolationR < numCoeffsR - filterOffset)
let outputsComputable = (VG.length bufLast * interpolationR + filterOffset) `quotUp` decimationR
count = min outputsComputable (space bufferOut)
assert "resample 4" (count /= 0)
(dat, endOffset) <- lift $ resampleCross dat count bufLast bufNext (VGM.unsafeDrop offsetOut bufOut)
assert "resample 5" ((count * decimationR + endOffset - filterOffset) `rem` interpolationR == 0)
bufferOut' <- advanceOutBuf blockSizeOut bufferOut count
let inputUsed = (count * decimationR - filterOffset) `quotUp` interpolationR
case inputUsed >= VG.length bufLast of
True -> simple (VG.drop (inputUsed - VG.length bufLast) bufNext) bufferOut' dat endOffset
False -> crossover (VG.drop inputUsed bufLast) bufNext bufferOut' dat endOffset
dcBlockingFilter :: Pipe (VS.Vector Float) (VS.Vector Float) IO ()
dcBlockingFilter = func 0 0
where
func lastSample lastOutput = do
dat <- await
out <- lift $ VGM.new (VG.length dat)
(lastSample, lastOutput) <- lift $ dcBlocker (VG.length dat) lastSample lastOutput dat out
outF <- lift $ VG.unsafeFreeze out
yield outF
func lastSample lastOutput