{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.Storable.Filter.NonRecursive (
delay,
delayPad,
delayPos,
delayNeg,
downsample2,
sumsDownsample2,
convolveDownsample2,
inverseFrequencyModulationFloor,
sumsPosModulatedPyramid,
accumulatePosModulatedPyramid,
accumulateBinPosModulatedPyramid,
movingAverageModulatedPyramid,
movingAccumulateModulatedPyramid,
sumsDownsample2Alt,
pyramid,
) where
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector as V
import qualified Data.StorableVector.Pointer as VPtr
import qualified Data.StorableVector.Lazy as VL
import qualified Data.StorableVector.Lazy.Pattern as VP
import qualified Synthesizer.Basic.Filter.NonRecursive as Filt
import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.Plain.Signal as Sig
import qualified Algebra.Module as Module
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import Foreign.Storable (Storable, )
import Foreign.Storable.Tuple ()
import Control.Monad (mplus, )
import qualified Data.List as List
import Data.Tuple.HT (mapFst, mapSnd, mapPair, swap, )
import Data.Maybe.HT (toMaybe, )
import Data.Maybe (fromMaybe, )
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import NumericPrelude.Numeric
import NumericPrelude.Base as NP
{-# INLINE delay #-}
delay :: (Additive.C y, Storable y) => Int -> SigSt.T y -> SigSt.T y
delay :: forall y. (C y, Storable y) => Int -> T y -> T y
delay = y -> Int -> T y -> T y
forall y. Storable y => y -> Int -> T y -> T y
delayPad y
forall a. C a => a
zero
{-# INLINE delayPad #-}
delayPad :: (Storable y) => y -> Int -> SigSt.T y -> SigSt.T y
delayPad :: forall y. Storable y => y -> Int -> T y -> T y
delayPad y
z Int
n =
if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
then Int -> T y -> T y
forall y. Storable y => Int -> T y -> T y
delayNeg (Int -> Int
forall a. C a => a -> a
Additive.negate Int
n)
else y -> Int -> T y -> T y
forall y. Storable y => y -> Int -> T y -> T y
delayPosPad y
z Int
n
{-# INLINE delayPos #-}
delayPos :: (Additive.C y, Storable y) => Int -> SigSt.T y -> SigSt.T y
delayPos :: forall y. (C y, Storable y) => Int -> T y -> T y
delayPos = y -> Int -> T y -> T y
forall y. Storable y => y -> Int -> T y -> T y
delayPosPad y
forall a. C a => a
zero
{-# INLINE delayPosPad #-}
delayPosPad :: (Storable v) => v -> Int -> SigSt.T v -> SigSt.T v
delayPosPad :: forall y. Storable y => y -> Int -> T y -> T y
delayPosPad v
z Int
n = Vector v -> Vector v -> Vector v
forall a. Storable a => Vector a -> Vector a -> Vector a
SigSt.append (ChunkSize -> Int -> v -> Vector v
forall a. Storable a => ChunkSize -> Int -> a -> Vector a
SigSt.replicate ChunkSize
SigSt.defaultChunkSize Int
n v
z)
{-# INLINE delayNeg #-}
delayNeg :: (Storable y) => Int -> SigSt.T y -> SigSt.T y
delayNeg :: forall y. Storable y => Int -> T y -> T y
delayNeg = Int -> Vector y -> Vector y
forall y. Storable y => Int -> T y -> T y
SigSt.drop
accumulateDownsample2Strict ::
(Storable v) =>
(v -> v -> v) ->
Maybe v -> V.Vector v -> (Maybe v, V.Vector v)
accumulateDownsample2Strict :: forall v.
Storable v =>
(v -> v -> v) -> Maybe v -> Vector v -> (Maybe v, Vector v)
accumulateDownsample2Strict v -> v -> v
acc Maybe v
carry Vector v
ys =
(Maybe (Maybe v, Vector v) -> Maybe v)
-> (Maybe (Maybe v, Vector v), Vector v) -> (Maybe v, Vector v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (\Maybe (Maybe v, Vector v)
v -> ((v, Vector v) -> v) -> Maybe (v, Vector v) -> Maybe v
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v, Vector v) -> v
forall a b. (a, b) -> a
fst (Maybe (v, Vector v) -> Maybe v) -> Maybe (v, Vector v) -> Maybe v
forall a b. (a -> b) -> a -> b
$ Vector v -> Maybe (v, Vector v)
forall a. Storable a => Vector a -> Maybe (a, Vector a)
V.viewL (Vector v -> Maybe (v, Vector v))
-> ((Maybe v, Vector v) -> Vector v)
-> (Maybe v, Vector v)
-> Maybe (v, Vector v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe v, Vector v) -> Vector v
forall a b. (a, b) -> b
snd ((Maybe v, Vector v) -> Maybe (v, Vector v))
-> Maybe (Maybe v, Vector v) -> Maybe (v, Vector v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Maybe v, Vector v)
v) ((Maybe (Maybe v, Vector v), Vector v) -> (Maybe v, Vector v))
-> (Maybe (Maybe v, Vector v), Vector v) -> (Maybe v, Vector v)
forall a b. (a -> b) -> a -> b
$ (Vector v, Maybe (Maybe v, Vector v))
-> (Maybe (Maybe v, Vector v), Vector v)
forall a b. (a, b) -> (b, a)
swap ((Vector v, Maybe (Maybe v, Vector v))
-> (Maybe (Maybe v, Vector v), Vector v))
-> (Vector v, Maybe (Maybe v, Vector v))
-> (Maybe (Maybe v, Vector v), Vector v)
forall a b. (a -> b) -> a -> b
$
Int
-> ((Maybe v, Vector v) -> Maybe (v, (Maybe v, Vector v)))
-> (Maybe v, Vector v)
-> (Vector v, Maybe (Maybe v, Vector v))
forall b a.
Storable b =>
Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
V.unfoldrN (Int -> Int -> Int
forall a. C a => a -> a -> a
div (Vector v -> Int
forall a. Vector a -> Int
V.length Vector v
ys Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int -> (v -> Int) -> Maybe v -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> v -> Int
forall a b. a -> b -> a
const Int
1) Maybe v
carry) Int
2) (\(Maybe v
carry0,Vector v
xs0) ->
do (v
x0,Vector v
xs1) <- Maybe (v, Vector v) -> Maybe (v, Vector v) -> Maybe (v, Vector v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ((v -> (v, Vector v)) -> Maybe v -> Maybe (v, Vector v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\v
c -> (v
c, Vector v
xs0)) Maybe v
carry0) (Vector v -> Maybe (v, Vector v)
forall a. Storable a => Vector a -> Maybe (a, Vector a)
V.viewL Vector v
xs0)
(v
x1,Vector v
xs2) <- Vector v -> Maybe (v, Vector v)
forall a. Storable a => Vector a -> Maybe (a, Vector a)
V.viewL Vector v
xs1
(v, (Maybe v, Vector v)) -> Maybe (v, (Maybe v, Vector v))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> v -> v
acc v
x0 v
x1, (Maybe v
forall a. Maybe a
Nothing, Vector v
xs2)))
(Maybe v
carry, Vector v
ys)
accumulateDownsample2 ::
(Storable v) =>
(v -> v -> v) ->
SigSt.T v -> SigSt.T v
accumulateDownsample2 :: forall v. Storable v => (v -> v -> v) -> T v -> T v
accumulateDownsample2 v -> v -> v
acc =
[Vector v] -> Vector v
forall a. Storable a => [Vector a] -> Vector a
SigSt.fromChunks ([Vector v] -> Vector v)
-> (Vector v -> [Vector v]) -> Vector v -> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Vector v -> Bool) -> [Vector v] -> [Vector v]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Vector v -> Bool) -> Vector v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector v -> Bool
forall a. Vector a -> Bool
V.null) ([Vector v] -> [Vector v])
-> (Vector v -> [Vector v]) -> Vector v -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\(Maybe v
carry, [Vector v]
chunks) ->
[Vector v]
chunks [Vector v] -> [Vector v] -> [Vector v]
forall a. [a] -> [a] -> [a]
++ [Vector v] -> (v -> [Vector v]) -> Maybe v -> [Vector v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\v
cr -> [v -> Vector v
forall a. Storable a => a -> Vector a
V.singleton v
cr]) Maybe v
carry) ((Maybe v, [Vector v]) -> [Vector v])
-> (Vector v -> (Maybe v, [Vector v])) -> Vector v -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Maybe v -> Vector v -> (Maybe v, Vector v))
-> Maybe v -> [Vector v] -> (Maybe v, [Vector v])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL ((v -> v -> v) -> Maybe v -> Vector v -> (Maybe v, Vector v)
forall v.
Storable v =>
(v -> v -> v) -> Maybe v -> Vector v -> (Maybe v, Vector v)
accumulateDownsample2Strict v -> v -> v
acc) Maybe v
forall a. Maybe a
Nothing ([Vector v] -> (Maybe v, [Vector v]))
-> (Vector v -> [Vector v]) -> Vector v -> (Maybe v, [Vector v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Vector v -> [Vector v]
forall a. Vector a -> [Vector a]
SigSt.chunks
sumsDownsample2 ::
(Additive.C v, Storable v) =>
SigSt.T v -> SigSt.T v
sumsDownsample2 :: forall v. (C v, Storable v) => T v -> T v
sumsDownsample2 =
(v -> v -> v) -> T v -> T v
forall v. Storable v => (v -> v -> v) -> T v -> T v
accumulateDownsample2 v -> v -> v
forall a. C a => a -> a -> a
(+)
sumsDownsample2Alt ::
(Additive.C v, Storable v) =>
SigSt.T v -> SigSt.T v
sumsDownsample2Alt :: forall v. (C v, Storable v) => T v -> T v
sumsDownsample2Alt T v
ys =
(T v, Maybe (T v)) -> T v
forall a b. (a, b) -> a
fst ((T v, Maybe (T v)) -> T v)
-> (T v -> (T v, Maybe (T v))) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
LazySize -> (T v -> Maybe (v, T v)) -> T v -> (T v, Maybe (T v))
forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
VP.unfoldrN (LazySize -> LazySize
halfLazySize (LazySize -> LazySize) -> LazySize -> LazySize
forall a b. (a -> b) -> a -> b
$ T v -> LazySize
forall a. Vector a -> LazySize
VP.length T v
ys) (\T v
xs ->
(((v, T v) -> (v, T v)) -> Maybe (v, T v) -> Maybe (v, T v))
-> Maybe (v, T v) -> ((v, T v) -> (v, T v)) -> Maybe (v, T v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((v, T v) -> (v, T v)) -> Maybe (v, T v) -> Maybe (v, T v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T v -> Maybe (v, T v)
forall a. T a -> Maybe (a, T a)
SigS.viewL T v
xs) (((v, T v) -> (v, T v)) -> Maybe (v, T v))
-> ((v, T v) -> (v, T v)) -> Maybe (v, T v)
forall a b. (a -> b) -> a -> b
$ \xxs0 :: (v, T v)
xxs0@(v
x0,T v
xs0) ->
(v, T v) -> (v -> T v -> (v, T v)) -> T v -> (v, T v)
forall b a. b -> (a -> T a -> b) -> T a -> b
SigS.switchL (v, T v)
xxs0
(\ v
x1 T v
xs1 -> (v
x0v -> v -> v
forall a. C a => a -> a -> a
+v
x1, T v
xs1))
T v
xs0)
(T v -> (T v, Maybe (T v)))
-> (T v -> T v) -> T v -> (T v, Maybe (T v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T v -> T v
forall a. Storable a => T a -> T a
SigS.fromStorableSignal (T v -> T v) -> T v -> T v
forall a b. (a -> b) -> a -> b
$ T v
ys
convolveDownsample2 ::
(Module.C a v, Storable a, Storable v) =>
SigSt.T a -> SigSt.T v -> SigSt.T v
convolveDownsample2 :: forall a v. (C a v, Storable a, Storable v) => T a -> T v -> T v
convolveDownsample2 T a
ms T v
ys =
let mac :: T v -> v
mac =
T v -> v
forall a. C a => T a -> a
SigS.sum (T v -> v) -> (T v -> T v) -> T v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> v -> v) -> T a -> T v -> T v
forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith a -> v -> v
forall a v. C a v => a -> v -> v
(*>)
(T a -> T a
forall a. Storable a => T a -> T a
SigS.fromStorableSignal T a
ms)
in (T v, Maybe (T v)) -> T v
forall a b. (a, b) -> a
fst ((T v, Maybe (T v)) -> T v)
-> (T v -> (T v, Maybe (T v))) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
LazySize -> (T v -> Maybe (v, T v)) -> T v -> (T v, Maybe (T v))
forall b a.
Storable b =>
LazySize -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
VP.unfoldrN (LazySize -> LazySize
halfLazySize (LazySize -> LazySize) -> LazySize -> LazySize
forall a b. (a -> b) -> a -> b
$ T v -> LazySize
forall a. Vector a -> LazySize
VP.length T v
ys) (\T v
xs ->
Bool -> (v, T v) -> Maybe (v, T v)
forall a. Bool -> a -> Maybe a
toMaybe (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ T v -> Bool
forall a. Storable a => Vector a -> Bool
SigSt.null T v
xs)
(T v -> v
mac (T v -> T v
forall a. Storable a => T a -> T a
SigS.fromStorableSignal T v
xs),
Int -> T v -> T v
forall y. Storable y => Int -> T y -> T y
SigSt.drop Int
2 T v
xs))
(T v -> T v) -> T v -> T v
forall a b. (a -> b) -> a -> b
$ T v
ys
halfLazySize :: NonNegChunky.T VP.ChunkSize -> NonNegChunky.T VP.ChunkSize
halfLazySize :: LazySize -> LazySize
halfLazySize =
[ChunkSize] -> LazySize
forall a. C a => [a] -> T a
NonNegChunky.fromChunks ([ChunkSize] -> LazySize)
-> (LazySize -> [ChunkSize]) -> LazySize -> LazySize
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(ChunkSize -> Bool) -> [ChunkSize] -> [ChunkSize]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> ChunkSize
VL.ChunkSize Int
forall a. C a => a
zero ChunkSize -> ChunkSize -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([ChunkSize] -> [ChunkSize])
-> (LazySize -> [ChunkSize]) -> LazySize -> [ChunkSize]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\(Int
c,[ChunkSize]
ls) -> [ChunkSize]
ls [ChunkSize] -> [ChunkSize] -> [ChunkSize]
forall a. [a] -> [a] -> [a]
++ [Int -> ChunkSize
VL.ChunkSize Int
c]) ((Int, [ChunkSize]) -> [ChunkSize])
-> (LazySize -> (Int, [ChunkSize])) -> LazySize -> [ChunkSize]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Int -> ChunkSize -> (Int, ChunkSize))
-> Int -> [ChunkSize] -> (Int, [ChunkSize])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (\Int
c (VL.ChunkSize Int
l) ->
(Int -> ChunkSize) -> (Int, Int) -> (Int, ChunkSize)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd Int -> ChunkSize
VL.ChunkSize ((Int, Int) -> (Int, ChunkSize)) -> (Int, Int) -> (Int, ChunkSize)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Int, Int)
forall a. C a => a -> a -> (a, a)
divMod (Int
cInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
l) Int
2) Int
forall a. C a => a
zero ([ChunkSize] -> (Int, [ChunkSize]))
-> (LazySize -> [ChunkSize]) -> LazySize -> (Int, [ChunkSize])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
LazySize -> [ChunkSize]
forall a. T a -> [a]
NonNegChunky.toChunks
downsample2Strict ::
(Storable v) =>
Int -> V.Vector v -> V.Vector v
downsample2Strict :: forall v. Storable v => Int -> Vector v -> Vector v
downsample2Strict Int
offset Vector v
ys =
(Vector v, Maybe (Vector v)) -> Vector v
forall a b. (a, b) -> a
fst ((Vector v, Maybe (Vector v)) -> Vector v)
-> (Vector v, Maybe (Vector v)) -> Vector v
forall a b. (a -> b) -> a -> b
$
Int
-> (Vector v -> Maybe (v, Vector v))
-> Vector v
-> (Vector v, Maybe (Vector v))
forall b a.
Storable b =>
Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
V.unfoldrN (- Int -> Int -> Int
forall a. C a => a -> a -> a
div (Int
offset Int -> Int -> Int
forall a. C a => a -> a -> a
- Vector v -> Int
forall a. Vector a -> Int
V.length Vector v
ys) Int
2)
(((v, Vector v) -> (v, Vector v))
-> Maybe (v, Vector v) -> Maybe (v, Vector v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector v -> Vector v) -> (v, Vector v) -> (v, Vector v)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd Vector v -> Vector v
forall v. Storable v => Vector v -> Vector v
laxTailStrict) (Maybe (v, Vector v) -> Maybe (v, Vector v))
-> (Vector v -> Maybe (v, Vector v))
-> Vector v
-> Maybe (v, Vector v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector v -> Maybe (v, Vector v)
forall a. Storable a => Vector a -> Maybe (a, Vector a)
V.viewL) (Vector v -> (Vector v, Maybe (Vector v)))
-> Vector v -> (Vector v, Maybe (Vector v))
forall a b. (a -> b) -> a -> b
$
if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Vector v
ys
else Vector v -> Vector v
forall v. Storable v => Vector v -> Vector v
laxTailStrict Vector v
ys
laxTailStrict ::
(Storable v) =>
V.Vector v -> V.Vector v
laxTailStrict :: forall v. Storable v => Vector v -> Vector v
laxTailStrict Vector v
ys =
Vector v -> (v -> Vector v -> Vector v) -> Vector v -> Vector v
forall a b.
Storable a =>
b -> (a -> Vector a -> b) -> Vector a -> b
V.switchL Vector v
ys ((Vector v -> v -> Vector v) -> v -> Vector v -> Vector v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector v -> v -> Vector v
forall a b. a -> b -> a
const) Vector v
ys
downsample2 ::
(Storable v) =>
SigSt.T v -> SigSt.T v
downsample2 :: forall v. Storable v => T v -> T v
downsample2 =
[Vector v] -> Vector v
forall a. Storable a => [Vector a] -> Vector a
SigSt.fromChunks ([Vector v] -> Vector v)
-> (Vector v -> [Vector v]) -> Vector v -> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Vector v -> Bool) -> [Vector v] -> [Vector v]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Vector v -> Bool) -> Vector v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector v -> Bool
forall a. Vector a -> Bool
V.null) ([Vector v] -> [Vector v])
-> (Vector v -> [Vector v]) -> Vector v -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Int, [Vector v]) -> [Vector v]
forall a b. (a, b) -> b
snd ((Int, [Vector v]) -> [Vector v])
-> (Vector v -> (Int, [Vector v])) -> Vector v -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Int -> Vector v -> (Int, Vector v))
-> Int -> [Vector v] -> (Int, [Vector v])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
(\Int
k Vector v
c ->
(Int -> Int -> Int
forall a. C a => a -> a -> a
mod (Int
k Int -> Int -> Int
forall a. C a => a -> a -> a
+ Vector v -> Int
forall a. Vector a -> Int
V.length Vector v
c) Int
2, Int -> Vector v -> Vector v
forall v. Storable v => Int -> Vector v -> Vector v
downsample2Strict Int
k Vector v
c)) Int
forall a. C a => a
zero ([Vector v] -> (Int, [Vector v]))
-> (Vector v -> [Vector v]) -> Vector v -> (Int, [Vector v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Vector v -> [Vector v]
forall a. Vector a -> [Vector a]
SigSt.chunks
pyramid ::
(Storable v) =>
(v -> v -> v) ->
Int -> SigSt.T v -> [SigSt.T v]
pyramid :: forall v. Storable v => (v -> v -> v) -> Int -> T v -> [T v]
pyramid v -> v -> v
acc Int
height =
Int -> [T v] -> [T v]
forall a. Int -> [a] -> [a]
take (Int
1Int -> Int -> Int
forall a. C a => a -> a -> a
+Int
height) ([T v] -> [T v]) -> (T v -> [T v]) -> T v -> [T v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T v -> T v) -> T v -> [T v]
forall a. (a -> a) -> a -> [a]
iterate ((v -> v -> v) -> T v -> T v
forall v. Storable v => (v -> v -> v) -> T v -> T v
accumulateDownsample2 v -> v -> v
acc)
accumulatePosModulatedPyramid ::
(Storable v) =>
([SigSt.T v] -> (Int,Int) -> v) ->
([Int], [SigSt.T v]) ->
SigSt.T (Int,Int) -> SigSt.T v
accumulatePosModulatedPyramid :: forall v.
Storable v =>
([T v] -> (Int, Int) -> v) -> ([Int], [T v]) -> T (Int, Int) -> T v
accumulatePosModulatedPyramid [T v] -> (Int, Int) -> v
accumulate ([Int]
sizes,[T v]
pyr0) T (Int, Int)
ctrl =
let blockSize :: Int
blockSize = [Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
sizes
pyrStarts :: [[T v]]
pyrStarts = ([T v] -> [T v]) -> [T v] -> [[T v]]
forall a. (a -> a) -> a -> [a]
iterate ((Int -> T v -> T v) -> [Int] -> [T v] -> [T v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> T v -> T v
forall y. Storable y => Int -> T y -> T y
SigSt.drop [Int]
sizes) [T v]
pyr0
ctrlBlocks :: [T (Int, Int)]
ctrlBlocks = T (T (Int, Int)) -> [T (Int, Int)]
forall y. T y -> [y]
SigS.toList (T (T (Int, Int)) -> [T (Int, Int)])
-> T (T (Int, Int)) -> [T (Int, Int)]
forall a b. (a -> b) -> a -> b
$ Int -> T (Int, Int) -> T (T (Int, Int))
forall sig. Transform sig => Int -> sig -> T sig
SigG.sliceVertical Int
blockSize T (Int, Int)
ctrl
in [Vector v] -> T v
forall a. Storable a => [Vector a] -> Vector a
SigSt.fromChunks ([Vector v] -> T v) -> [Vector v] -> T v
forall a b. (a -> b) -> a -> b
$
([T v] -> T (Int, Int) -> Vector v)
-> [[T v]] -> [T (Int, Int)] -> [Vector v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\[T v]
pyr ->
Int -> T v -> Vector v
forall a. Storable a => Int -> T a -> Vector a
SigS.toStrictStorableSignal Int
blockSize (T v -> Vector v)
-> (T (Int, Int) -> T v) -> T (Int, Int) -> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Int, Int) -> v) -> T (Int, Int) -> T v
forall a b. (a -> b) -> T a -> T b
SigS.map ([T v] -> (Int, Int) -> v
accumulate [T v]
pyr) (T (Int, Int) -> T v)
-> (T (Int, Int) -> T (Int, Int)) -> T (Int, Int) -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Int -> (Int, Int) -> (Int, Int))
-> T Int -> T (Int, Int) -> T (Int, Int)
forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith (\Int
d -> (Int -> Int, Int -> Int) -> (Int, Int) -> (Int, Int)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((Int
dInt -> Int -> Int
forall a. C a => a -> a -> a
+), (Int
dInt -> Int -> Int
forall a. C a => a -> a -> a
+))) ((Int -> Int) -> Int -> T Int
forall a. (a -> a) -> a -> T a
SigS.iterate (Int
1Int -> Int -> Int
forall a. C a => a -> a -> a
+) Int
0) (T (Int, Int) -> T (Int, Int))
-> (T (Int, Int) -> T (Int, Int)) -> T (Int, Int) -> T (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T (Int, Int) -> T (Int, Int)
forall a. Storable a => T a -> T a
SigS.fromStorableSignal)
[[T v]]
pyrStarts [T (Int, Int)]
ctrlBlocks
sumsPosModulatedPyramid ::
(Additive.C v, Storable v) =>
Int -> SigSt.T (Int,Int) -> SigSt.T v -> SigSt.T v
sumsPosModulatedPyramid :: forall v. (C v, Storable v) => Int -> T (Int, Int) -> T v -> T v
sumsPosModulatedPyramid Int
height T (Int, Int)
ctrl T v
xs =
([T v] -> (Int, Int) -> v) -> ([Int], [T v]) -> T (Int, Int) -> T v
forall v.
Storable v =>
([T v] -> (Int, Int) -> v) -> ([Int], [T v]) -> T (Int, Int) -> T v
accumulatePosModulatedPyramid
[T v] -> (Int, Int) -> v
forall v (sig :: * -> *).
(C v, Transform sig v) =>
[sig v] -> (Int, Int) -> v
FiltG.sumRangeFromPyramid
([T v] -> ([Int], [T v])
forall signal. [signal] -> ([Int], [signal])
addSizes ([T v] -> ([Int], [T v])) -> [T v] -> ([Int], [T v])
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> Int -> T v -> [T v]
forall v. Storable v => (v -> v -> v) -> Int -> T v -> [T v]
pyramid v -> v -> v
forall a. C a => a -> a -> a
(+) Int
height T v
xs)
T (Int, Int)
ctrl
accumulateBinPosModulatedPyramid ::
(Storable v) =>
(v -> v -> v) ->
Int -> SigSt.T (Int,Int) -> SigSt.T v -> SigSt.T v
accumulateBinPosModulatedPyramid :: forall v.
Storable v =>
(v -> v -> v) -> Int -> T (Int, Int) -> T v -> T v
accumulateBinPosModulatedPyramid v -> v -> v
acc Int
height T (Int, Int)
ctrl T v
xs =
([T v] -> (Int, Int) -> v) -> ([Int], [T v]) -> T (Int, Int) -> T v
forall v.
Storable v =>
([T v] -> (Int, Int) -> v) -> ([Int], [T v]) -> T (Int, Int) -> T v
accumulatePosModulatedPyramid
(\[T v]
pyr ->
v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"accumulateBinPosModulatedPyramid: empty window") (Maybe v -> v) -> ((Int, Int) -> Maybe v) -> (Int, Int) -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(v -> v -> v) -> [T v] -> (Int, Int) -> Maybe v
forall (sig :: * -> *) v.
Transform sig v =>
(v -> v -> v) -> [sig v] -> (Int, Int) -> Maybe v
FiltG.maybeAccumulateRangeFromPyramid v -> v -> v
acc [T v]
pyr)
([T v] -> ([Int], [T v])
forall signal. [signal] -> ([Int], [signal])
addSizes ([T v] -> ([Int], [T v])) -> [T v] -> ([Int], [T v])
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> Int -> T v -> [T v]
forall v. Storable v => (v -> v -> v) -> Int -> T v -> [T v]
pyramid v -> v -> v
acc Int
height T v
xs)
T (Int, Int)
ctrl
addSizes :: [signal] -> ([Int], [signal])
addSizes :: forall signal. [signal] -> ([Int], [signal])
addSizes [signal]
pyr = ([signal] -> [Int]
forall signal. [signal] -> [Int]
Filt.unitSizesFromPyramid [signal]
pyr, [signal]
pyr)
movingAverageModulatedPyramid ::
(Field.C a, Module.C a v, Storable Int, Storable v) =>
a -> Int -> Int -> SigSt.T Int -> SigSt.T v -> SigSt.T v
movingAverageModulatedPyramid :: forall a v.
(C a, C a v, Storable Int, Storable v) =>
a -> Int -> Int -> T Int -> T v -> T v
movingAverageModulatedPyramid a
amp Int
height Int
maxC T Int
ctrl0 =
v -> (T (Int, Int) -> T v -> T v) -> Int -> T Int -> T v -> T v
forall y v.
Storable y =>
y -> (T (Int, Int) -> T y -> v) -> Int -> T Int -> T y -> v
withPaddedInput v
forall a. C a => a
zero
(\T (Int, Int)
ctrl T v
xs ->
(Int -> v -> v) -> T Int -> T v -> T v
forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
SigSt.zipWith (\Int
c v
x -> (a
amp a -> a -> a
forall a. C a => a -> a -> a
/ Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral (Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1)) a -> v -> v
forall a v. C a v => a -> v -> v
*> v
x) T Int
ctrl0 (T v -> T v) -> T v -> T v
forall a b. (a -> b) -> a -> b
$
Int -> T (Int, Int) -> T v -> T v
forall v. (C v, Storable v) => Int -> T (Int, Int) -> T v -> T v
sumsPosModulatedPyramid Int
height T (Int, Int)
ctrl T v
xs)
Int
maxC T Int
ctrl0
movingAccumulateModulatedPyramid ::
(Storable v) =>
(v -> v -> v) ->
v -> Int -> Int -> SigSt.T Int -> SigSt.T v -> SigSt.T v
movingAccumulateModulatedPyramid :: forall v.
Storable v =>
(v -> v -> v) -> v -> Int -> Int -> T Int -> T v -> T v
movingAccumulateModulatedPyramid v -> v -> v
acc v
pad Int
height =
v -> (T (Int, Int) -> T v -> T v) -> Int -> T Int -> T v -> T v
forall y v.
Storable y =>
y -> (T (Int, Int) -> T y -> v) -> Int -> T Int -> T y -> v
withPaddedInput v
pad ((T (Int, Int) -> T v -> T v) -> Int -> T Int -> T v -> T v)
-> (T (Int, Int) -> T v -> T v) -> Int -> T Int -> T v -> T v
forall a b. (a -> b) -> a -> b
$
(v -> v -> v) -> Int -> T (Int, Int) -> T v -> T v
forall v.
Storable v =>
(v -> v -> v) -> Int -> T (Int, Int) -> T v -> T v
accumulateBinPosModulatedPyramid v -> v -> v
acc Int
height
withPaddedInput ::
(Storable y) =>
y -> (SigSt.T (Int, Int) -> SigSt.T y -> v) ->
Int -> SigSt.T Int -> SigSt.T y -> v
withPaddedInput :: forall y v.
Storable y =>
y -> (T (Int, Int) -> T y -> v) -> Int -> T Int -> T y -> v
withPaddedInput y
pad T (Int, Int) -> T y -> v
proc Int
maxC T Int
ctrl T y
xs =
T (Int, Int) -> T y -> v
proc
((Int -> (Int, Int)) -> T Int -> T (Int, Int)
forall x y.
(Storable x, Storable y) =>
(x -> y) -> Vector x -> Vector y
SigSt.map (\Int
c -> (Int
maxC Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
c, Int
maxC Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
c Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1)) T Int
ctrl)
(y -> Int -> T y -> T y
forall y. Storable y => y -> Int -> T y -> T y
delayPad y
pad Int
maxC T y
xs)
{-# INLINE inverseFrequencyModulationFloor #-}
inverseFrequencyModulationFloor ::
(Storable v, SigG.Read sig t, Ring.C t, Ord t) =>
SigSt.ChunkSize ->
sig t -> SigSt.T v -> SigSt.T v
inverseFrequencyModulationFloor :: forall v (sig :: * -> *) t.
(Storable v, Read sig t, C t, Ord t) =>
ChunkSize -> sig t -> T v -> T v
inverseFrequencyModulationFloor ChunkSize
chunkSize sig t
ctrl =
sig t
-> (forall s. (s -> Maybe (t, s)) -> s -> T v -> T v) -> T v -> T v
forall (sig :: * -> *) y x.
Read sig y =>
sig y -> (forall s. (s -> Maybe (y, s)) -> s -> x) -> x
SigG.runViewL sig t
ctrl (\s -> Maybe (t, s)
nextC s
cst0 ->
[T v] -> T v
forall a. Storable a => [Vector a] -> Vector a
SigSt.concat ([T v] -> T v) -> (T v -> [T v]) -> T v -> T v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Vector v -> Maybe (t, s) -> Maybe (T v, Maybe (t, s)))
-> Maybe (t, s) -> T (Vector v) -> [T v]
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
Sig.crochetL
(\Vector v
chunk Maybe (t, s)
ms -> (((t, s) -> (T v, Maybe (t, s)))
-> Maybe (t, s) -> Maybe (T v, Maybe (t, s)))
-> Maybe (t, s)
-> ((t, s) -> (T v, Maybe (t, s)))
-> Maybe (T v, Maybe (t, s))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((t, s) -> (T v, Maybe (t, s)))
-> Maybe (t, s) -> Maybe (T v, Maybe (t, s))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (t, s)
ms (((t, s) -> (T v, Maybe (t, s))) -> Maybe (T v, Maybe (t, s)))
-> ((t, s) -> (T v, Maybe (t, s))) -> Maybe (T v, Maybe (t, s))
forall a b. (a -> b) -> a -> b
$ \(t, s)
ts ->
ChunkSize
-> (s -> Maybe (t, s)) -> (t, s) -> Vector v -> (T v, Maybe (t, s))
forall v t s.
(Storable v, C t, Ord t) =>
ChunkSize
-> (s -> Maybe (t, s)) -> (t, s) -> Vector v -> (T v, Maybe (t, s))
inverseFrequencyModulationChunk ChunkSize
chunkSize
s -> Maybe (t, s)
nextC (t, s)
ts Vector v
chunk)
((t, s) -> Maybe (t, s)
forall a. a -> Maybe a
Just (t
0,s
cst0)) (T (Vector v) -> [T v]) -> (T v -> T (Vector v)) -> T v -> [T v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T v -> T (Vector v)
forall a. Vector a -> [Vector a]
SigSt.chunks)
{-# INLINE inverseFrequencyModulationChunk #-}
inverseFrequencyModulationChunk ::
(Storable v, Ring.C t, Ord t) =>
SigSt.ChunkSize ->
(s -> Maybe (t,s)) -> (t,s) -> V.Vector v -> (SigSt.T v, Maybe (t,s))
inverseFrequencyModulationChunk :: forall v t s.
(Storable v, C t, Ord t) =>
ChunkSize
-> (s -> Maybe (t, s)) -> (t, s) -> Vector v -> (T v, Maybe (t, s))
inverseFrequencyModulationChunk ChunkSize
chunkSize s -> Maybe (t, s)
nextC (t
phase,s
cst0) Vector v
chunk =
let {-# INLINE switch #-}
switch :: (Maybe (t, s) -> b)
-> ((t, b) -> (s, Pointer b) -> b) -> t -> (s, Pointer b) -> b
switch Maybe (t, s) -> b
l (t, b) -> (s, Pointer b) -> b
r t
t (s
cp0,Pointer b
xp0) =
b -> ((t, s) -> b) -> Maybe (t, s) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe (t, s) -> b
l Maybe (t, s)
forall a. Maybe a
Nothing)
(\(t
c1,s
cp1) ->
b -> (b -> Pointer b -> b) -> Pointer b -> b
forall a b.
Storable a =>
b -> (a -> Pointer a -> b) -> Pointer a -> b
VPtr.switchL
(Maybe (t, s) -> b
l ((t, s) -> Maybe (t, s)
forall a. a -> Maybe a
Just (t
t,s
cp0)))
(\b
x1 Pointer b
xp1 -> (t, b) -> (s, Pointer b) -> b
r (t
tt -> t -> t
forall a. C a => a -> a -> a
+t
c1,b
x1) (s
cp1,Pointer b
xp1))
Pointer b
xp0)
(s -> Maybe (t, s)
nextC s
cp0)
{-# INLINE go #-}
go :: (t, b)
-> (s, Pointer b)
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b)))
go (t
c,b
x) (s, Pointer b)
cxp =
if t
ct -> t -> Bool
forall a. Ord a => a -> a -> Bool
<t
1
then (Maybe (t, s)
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b))))
-> ((t, b)
-> (s, Pointer b)
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b))))
-> t
-> (s, Pointer b)
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b)))
forall {b} {b}.
Storable b =>
(Maybe (t, s) -> b)
-> ((t, b) -> (s, Pointer b) -> b) -> t -> (s, Pointer b) -> b
switch Maybe (t, s) -> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b)))
forall a b. a -> Either a b
Left (t, b)
-> (s, Pointer b)
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b)))
go t
c (s, Pointer b)
cxp
else (b, ((t, b), (s, Pointer b)))
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b)))
forall a b. b -> Either a b
Right (b
x, ((t
ct -> t -> t
forall a. C a => a -> a -> a
-t
1,b
x),(s, Pointer b)
cxp))
in (Maybe (t, s) -> (T v, Maybe (t, s)))
-> ((t, v) -> (s, Pointer v) -> (T v, Maybe (t, s)))
-> t
-> (s, Pointer v)
-> (T v, Maybe (t, s))
forall {b} {b}.
Storable b =>
(Maybe (t, s) -> b)
-> ((t, b) -> (s, Pointer b) -> b) -> t -> (s, Pointer b) -> b
switch ((,) T v
forall a. Storable a => Vector a
SigSt.empty)
((((t, v), (s, Pointer v)) -> (T v, Maybe (t, s)))
-> (t, v) -> (s, Pointer v) -> (T v, Maybe (t, s))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((((t, v), (s, Pointer v)) -> (T v, Maybe (t, s)))
-> (t, v) -> (s, Pointer v) -> (T v, Maybe (t, s)))
-> (((t, v), (s, Pointer v)) -> (T v, Maybe (t, s)))
-> (t, v)
-> (s, Pointer v)
-> (T v, Maybe (t, s))
forall a b. (a -> b) -> a -> b
$ ChunkSize
-> (((t, v), (s, Pointer v))
-> Either (Maybe (t, s)) (v, ((t, v), (s, Pointer v))))
-> ((t, v), (s, Pointer v))
-> (T v, Maybe (t, s))
forall b a c.
Storable b =>
ChunkSize -> (a -> Either c (b, a)) -> a -> (Vector b, c)
VL.unfoldrResult ChunkSize
chunkSize (((t, v)
-> (s, Pointer v)
-> Either (Maybe (t, s)) (v, ((t, v), (s, Pointer v))))
-> ((t, v), (s, Pointer v))
-> Either (Maybe (t, s)) (v, ((t, v), (s, Pointer v)))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (t, v)
-> (s, Pointer v)
-> Either (Maybe (t, s)) (v, ((t, v), (s, Pointer v)))
forall {b}.
Storable b =>
(t, b)
-> (s, Pointer b)
-> Either (Maybe (t, s)) (b, ((t, b), (s, Pointer b)))
go))
t
phase (s
cst0, Vector v -> Pointer v
forall a. Storable a => Vector a -> Pointer a
VPtr.cons Vector v
chunk)