module Feldspar.Processing.Filters where



import Prelude ()

import Feldspar
import Feldspar.Data.Vector
import Feldspar.Data.Queue



recurrenceI
    :: ( Pushy m fvec a
       , Finite fvec
       , Seqy m ivec a
       , Syntax a, Syntax b
       , MonadComp m
       )
    => fvec           -- ^ Initial input buffer
    -> ivec           -- ^ Input vector
    -> (Pull a -> b)  -- ^ Step function, producing one output from previous inputs
    -> Seq m b        -- ^ Output vector
recurrenceI :: fvec -> ivec -> (Pull a -> b) -> Seq m b
recurrenceI fvec
ii ivec
vec Pull a -> b
body = Data Length -> m (Data Length -> m b) -> Seq m b
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq Data Length
len (m (Data Length -> m b) -> Seq m b)
-> m (Data Length -> m b) -> Seq m b
forall a b. (a -> b) -> a -> b
$ do
    Data Length -> m a
next <- m (Data Length -> m a)
init
    Queue a
buf  <- fvec -> m (Queue a)
forall (m :: * -> *) vec a.
(Pushy m vec a, Finite vec, Syntax a, MonadComp m) =>
vec -> m (Queue a)
initQueue2 fvec
ii
    (Data Length -> m b) -> m (Data Length -> m b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m b) -> m (Data Length -> m b))
-> (Data Length -> m b) -> m (Data Length -> m b)
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> do
      a
a <- Data Length -> m a
next Data Length
i
      Data Bool -> m () -> m () -> m ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff (fvec -> Data Length
forall a. Finite a => a -> Data Length
length fvec
ii Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
/= Data Length
0)
        (Queue a -> a -> m ()
forall a. Queue a -> forall (m :: * -> *). MonadComp m => a -> m ()
putQ Queue a
buf a
a)
        (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      Queue a -> (Pull a -> m b) -> m b
forall a.
Queue a
-> forall (m :: * -> *) b.
   (Syntax b, MonadComp m) =>
   (Pull a -> m b) -> m b
withQ Queue a
buf (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (Pull a -> b) -> Pull a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pull a -> b
body)
  where
    Seq Data Length
len m (Data Length -> m a)
init = ivec -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq ivec
vec

recurrenceIO
    :: ( Pushy m fvec a
       , Finite fvec
       , Seqy m ivec a
       , Pushy m bvec b
       , Finite bvec
       , Syntax a, Syntax b
       , MonadComp m
       )
    => fvec                     -- ^ Initial input buffer
    -> ivec                     -- ^ Input vector
    -> bvec                     -- ^ Initial output buffer
    -> (Pull a -> Pull b -> b)  -- ^ Step function, producing one output from
                                --   previous inputs and outputs
    -> Seq m b                  -- ^ Output vector
recurrenceIO :: fvec -> ivec -> bvec -> (Pull a -> Pull b -> b) -> Seq m b
recurrenceIO fvec
ii ivec
vec bvec
io Pull a -> Pull b -> b
body = Data Length -> m (Data Length -> m b) -> Seq m b
forall (m :: * -> *) a.
Data Length -> m (Data Length -> m a) -> Seq m a
Seq Data Length
len (m (Data Length -> m b) -> Seq m b)
-> m (Data Length -> m b) -> Seq m b
forall a b. (a -> b) -> a -> b
$ do
    Data Length -> m a
next <- m (Data Length -> m a)
init
    Queue a
ibuf <- fvec -> m (Queue a)
forall (m :: * -> *) vec a.
(Pushy m vec a, Finite vec, Syntax a, MonadComp m) =>
vec -> m (Queue a)
initQueue2 fvec
ii
    Queue b
obuf <- bvec -> m (Queue b)
forall (m :: * -> *) vec a.
(Pushy m vec a, Finite vec, Syntax a, MonadComp m) =>
vec -> m (Queue a)
initQueue2 bvec
io
    (Data Length -> m b) -> m (Data Length -> m b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Data Length -> m b) -> m (Data Length -> m b))
-> (Data Length -> m b) -> m (Data Length -> m b)
forall a b. (a -> b) -> a -> b
$ \Data Length
i -> do
      a
a <- Data Length -> m a
next Data Length
i
      Data Bool -> m () -> m () -> m ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff (fvec -> Data Length
forall a. Finite a => a -> Data Length
length fvec
ii Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
/= Data Length
0)
        (Queue a -> a -> m ()
forall a. Queue a -> forall (m :: * -> *). MonadComp m => a -> m ()
putQ Queue a
ibuf a
a)
        (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      b
b <- Queue a
-> forall (m :: * -> *) b.
   (Syntax b, MonadComp m) =>
   (Pull a -> m b) -> m b
forall a.
Queue a
-> forall (m :: * -> *) b.
   (Syntax b, MonadComp m) =>
   (Pull a -> m b) -> m b
withQ Queue a
ibuf ((Pull a -> m b) -> m b) -> (Pull a -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \Pull a
ib ->
             Queue b
-> forall (m :: * -> *) b.
   (Syntax b, MonadComp m) =>
   (Pull b -> m b) -> m b
forall a.
Queue a
-> forall (m :: * -> *) b.
   (Syntax b, MonadComp m) =>
   (Pull a -> m b) -> m b
withQ Queue b
obuf ((Pull b -> m b) -> m b) -> (Pull b -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \Pull b
ob ->
               b -> m b
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m a
shareM (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Pull a -> Pull b -> b
body Pull a
ib Pull b
ob
                 -- Sharing important since `b` is shared
      Data Bool -> m () -> m () -> m ()
forall (m :: * -> *).
MonadComp m =>
Data Bool -> m () -> m () -> m ()
iff (bvec -> Data Length
forall a. Finite a => a -> Data Length
length bvec
io Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
/= Data Length
0)
        (Queue b -> b -> m ()
forall a. Queue a -> forall (m :: * -> *). MonadComp m => a -> m ()
putQ Queue b
obuf b
b)
        (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
  where
    Seq Data Length
len m (Data Length -> m a)
init = ivec -> Seq m a
forall (m :: * -> *) vec a. Seqy m vec a => vec -> Seq m a
toSeq ivec
vec

-- | FIR filter
fir :: (Pully fvec a, Seqy m ivec a, Syntax a, Num a, MonadComp m)
    => fvec     -- ^ Filter coefficients
    -> ivec     -- ^ Input vector
    -> Seq m a  -- ^ Output vector
fir :: fvec -> ivec -> Seq m a
fir fvec
bs ivec
inp = Pull a -> ivec -> (Pull a -> a) -> Seq m a
forall (m :: * -> *) fvec a ivec b.
(Pushy m fvec a, Finite fvec, Seqy m ivec a, Syntax a, Syntax b,
 MonadComp m) =>
fvec -> ivec -> (Pull a -> b) -> Seq m b
recurrenceI (Data Length -> a -> Pull a
forall a. Data Length -> a -> Pull a
replicate (fvec -> Data Length
forall a. Finite a => a -> Data Length
length fvec
bs) a
0) ivec
inp ((Pull a -> a) -> Seq m a) -> (Pull a -> a) -> Seq m a
forall a b. (a -> b) -> a -> b
$ \Pull a
i ->
    fvec -> Pull a -> a
forall a vec1 vec2.
(Num a, Syntax a, Pully vec1 a, Pully vec2 a) =>
vec1 -> vec2 -> a
scProd fvec
bs Pull a
i

-- | IIR filter
iir :: ( Pully bvec a, Pully fvec a
       , Seqy m ivec a, Syntax a
       , Fractional a
       , MonadComp m
       )
    => a        -- ^ First feedback coefficient
    -> bvec     -- ^ Remaining feedback coefficients
    -> fvec     -- ^ Feedforward coefficients
    -> ivec     -- ^ Input vector
    -> Seq m a  -- ^ Output vector
iir :: a -> bvec -> fvec -> ivec -> Seq m a
iir a
a0 bvec
as fvec
bs ivec
inp = Pull a -> ivec -> Pull a -> (Pull a -> Pull a -> a) -> Seq m a
forall (m :: * -> *) fvec a ivec bvec b.
(Pushy m fvec a, Finite fvec, Seqy m ivec a, Pushy m bvec b,
 Finite bvec, Syntax a, Syntax b, MonadComp m) =>
fvec -> ivec -> bvec -> (Pull a -> Pull b -> b) -> Seq m b
recurrenceIO
    (Data Length -> a -> Pull a
forall a. Data Length -> a -> Pull a
replicate (fvec -> Data Length
forall a. Finite a => a -> Data Length
length fvec
bs) a
0)
    ivec
inp
    (Data Length -> a -> Pull a
forall a. Data Length -> a -> Pull a
replicate (bvec -> Data Length
forall a. Finite a => a -> Data Length
length bvec
as) a
0)
    (\Pull a
i Pull a
o -> a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
a0 a -> a -> a
forall a. Num a => a -> a -> a
* (fvec -> Pull a -> a
forall a vec1 vec2.
(Num a, Syntax a, Pully vec1 a, Pully vec2 a) =>
vec1 -> vec2 -> a
scProd fvec
bs Pull a
i a -> a -> a
forall a. Num a => a -> a -> a
- bvec -> Pull a -> a
forall a vec1 vec2.
(Num a, Syntax a, Pully vec1 a, Pully vec2 a) =>
vec1 -> vec2 -> a
scProd bvec
as Pull a
o))

-- | FIR filter for 'Pull' vectors
--
-- This version avoids creating a queue for previous inputs (since they are all
-- available anyway).
--
-- Note that each input element is referred many times, so the input should
-- normally be a 'Manifest'. In particular, this means that it is usually not a
-- good idea to compose 'firPull' without writing to memory in between.
firPull :: (Pully vec1 a, Pully vec2 a, Syntax a, Num a)
    => vec1    -- ^ Filter coefficients
    -> vec2    -- ^ Input vector
    -> Pull a  -- ^ Output vector
firPull :: vec1 -> vec2 -> Pull a
firPull vec1
bs = (Pull a -> a) -> Pull (Pull a) -> Pull a
forall vec a b. Pully vec a => (a -> b) -> vec -> Pull b
map (vec1 -> Pull a -> a
forall a vec1 vec2.
(Num a, Syntax a, Pully vec1 a, Pully vec2 a) =>
vec1 -> vec2 -> a
scProd vec1
bs (Pull a -> a) -> (Pull a -> Pull a) -> Pull a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pull a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
reverse) (Pull (Pull a) -> Pull a)
-> (vec2 -> Pull (Pull a)) -> vec2 -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pull (Pull a) -> Pull (Pull a)
forall vec a. Pully vec a => vec -> Pull a
tail (Pull (Pull a) -> Pull (Pull a))
-> (vec2 -> Pull (Pull a)) -> vec2 -> Pull (Pull a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vec2 -> Pull (Pull a)
forall vec a. Pully vec a => vec -> Pull (Pull a)
inits