{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Generic.Filter.Recursive.MovingAverage (
sumsStaticInt,
modulatedFrac,
) where
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Filter.Recursive.Integration as Integration
import qualified Synthesizer.Generic.Filter.Delay as Delay
import qualified Synthesizer.State.Signal as SigS
import Data.Function.HT (nest, )
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE sumsStaticInt #-}
sumsStaticInt :: (Additive.C v, SigG.Write sig v) =>
Int -> sig v -> sig v
sumsStaticInt :: forall v (sig :: * -> *).
(C v, Write sig v) =>
Int -> sig v -> sig v
sumsStaticInt Int
n sig v
xs =
sig v -> sig v
forall v (sig :: * -> *). (C v, Transform sig v) => sig v -> sig v
Integration.run (sig v -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
sub sig v
xs (Int -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Write sig v) =>
Int -> sig v -> sig v
Delay.staticPos Int
n sig v
xs))
{-# INLINE sub #-}
sub :: (Additive.C v, SigG.Transform sig v) =>
sig v -> sig v -> sig v
sub :: forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
sub sig v
xs sig v
ys =
sig v -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
SigG.mix sig v
xs ((v -> v) -> sig v -> sig v
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map v -> v
forall a. C a => a -> a
Additive.negate sig v
ys)
{-# INLINE sumFromToFrac #-}
sumFromToFrac ::
(RealField.C a, Module.C a v, SigG.Transform sig v) =>
a -> a -> sig v -> v
sumFromToFrac :: forall a v (sig :: * -> *).
(C a, C a v, Transform sig v) =>
a -> a -> sig v -> v
sumFromToFrac a
from a
to sig v
xs =
let (Int
fromInt, a
fromFrac) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
from
(Int
toInt, a
toFrac) = a -> (Int, a)
forall b. C b => a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
to
in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
fromInt Int
toInt of
Ordering
EQ -> (a
toa -> a -> a
forall a. C a => a -> a -> a
-a
from) a -> v -> v
forall a v. C a v => a -> v -> v
*> v -> Int -> sig v -> v
forall (sig :: * -> *) y. Transform sig y => y -> Int -> sig y -> y
index v
forall a. C a => a
zero Int
fromInt sig v
xs
Ordering
LT ->
((v -> v) -> (v -> sig v -> v) -> v -> sig v -> v
forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext ((a
1a -> a -> a
forall a. C a => a -> a -> a
-a
fromFrac) a -> v -> v
forall a v. C a v => a -> v -> v
*>) ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v) -> v -> sig v -> v
forall a b. (a -> b) -> a -> b
$
Int
-> ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v)
-> v
-> sig v
-> v
forall a. Int -> (a -> a) -> a -> a
nest (Int
toIntInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
fromIntInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) ((v -> v) -> (v -> sig v -> v) -> v -> sig v -> v
forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext v -> v
forall a. a -> a
id) ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v) -> v -> sig v -> v
forall a b. (a -> b) -> a -> b
$
(v -> v) -> (v -> sig v -> v) -> v -> sig v -> v
forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext (a
toFrac a -> v -> v
forall a v. C a v => a -> v -> v
*>) ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v) -> v -> sig v -> v
forall a b. (a -> b) -> a -> b
$
v -> sig v -> v
forall a b. a -> b -> a
const)
v
forall a. C a => a
zero (Int -> sig v -> sig v
forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
fromInt sig v
xs)
Ordering
GT ->
((v -> v) -> (v -> sig v -> v) -> v -> sig v -> v
forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext ((a
1a -> a -> a
forall a. C a => a -> a -> a
-a
toFrac) a -> v -> v
forall a v. C a v => a -> v -> v
*>) ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v) -> v -> sig v -> v
forall a b. (a -> b) -> a -> b
$
Int
-> ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v)
-> v
-> sig v
-> v
forall a. Int -> (a -> a) -> a -> a
nest (Int
fromIntInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
toIntInt -> Int -> Int
forall a. C a => a -> a -> a
-Int
1) ((v -> v) -> (v -> sig v -> v) -> v -> sig v -> v
forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext v -> v
forall a. a -> a
id) ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v) -> v -> sig v -> v
forall a b. (a -> b) -> a -> b
$
(v -> v) -> (v -> sig v -> v) -> v -> sig v -> v
forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext (a
fromFrac a -> v -> v
forall a v. C a v => a -> v -> v
*>) ((v -> sig v -> v) -> v -> sig v -> v)
-> (v -> sig v -> v) -> v -> sig v -> v
forall a b. (a -> b) -> a -> b
$
v -> sig v -> v
forall a b. a -> b -> a
const)
v
forall a. C a => a
zero (Int -> sig v -> sig v
forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
toInt sig v
xs)
{-# INLINE index #-}
index ::
(SigG.Transform sig y) =>
y -> Int -> sig y -> y
index :: forall (sig :: * -> *) y. Transform sig y => y -> Int -> sig y -> y
index y
deflt Int
n =
y -> ((y, sig y) -> y) -> Maybe (y, sig y) -> y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe y
deflt (y, sig y) -> y
forall a b. (a, b) -> a
fst (Maybe (y, sig y) -> y)
-> (sig y -> Maybe (y, sig y)) -> sig y -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sig y -> Maybe (y, sig y)
forall y. Storage (sig y) => sig y -> Maybe (y, sig y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (y, sig y)
SigG.viewL (sig y -> Maybe (y, sig y))
-> (sig y -> sig y) -> sig y -> Maybe (y, sig y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> sig y -> sig y
forall sig. Transform sig => Int -> sig -> sig
SigG.drop Int
n
{-# INLINE addNext #-}
addNext ::
(Additive.C v, SigG.Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext :: forall v (sig :: * -> *) a.
(C v, Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext a -> v
f v -> sig a -> v
next v
s =
v -> (a -> sig a -> v) -> sig a -> v
forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL v
s
(\a
y sig a
ys -> v -> sig a -> v
next (v
s v -> v -> v
forall a. C a => a -> a -> a
+ a -> v
f a
y) sig a
ys)
{-# INLINE sumDiffsModulated #-}
sumDiffsModulated ::
(RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Transform sig v) =>
a -> sig a -> sig v -> sig v
sumDiffsModulated :: forall a v (sig :: * -> *).
(C a, C a v, Transform sig a, Transform sig v) =>
a -> sig a -> sig v -> sig v
sumDiffsModulated a
d sig a
ds =
sig v -> ((sig v, v) -> sig v) -> Maybe (sig v, v) -> sig v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> sig v
forall a. HasCallStack => [Char] -> a
error [Char]
"MovingAverage: signal must be non-empty because we prepended a zero before") (sig v, v) -> sig v
forall a b. (a, b) -> a
fst (Maybe (sig v, v) -> sig v)
-> (sig v -> Maybe (sig v, v)) -> sig v -> sig v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
sig v -> Maybe (sig v, v)
forall y. Storage (sig y) => sig y -> Maybe (sig y, y)
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (sig y, y)
SigG.viewR (sig v -> Maybe (sig v, v))
-> (sig v -> sig v) -> sig v -> Maybe (sig v, v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(a -> a -> sig v -> v) -> sig a -> sig a -> sig v -> sig v
forall (sig :: * -> *) a v.
(Transform sig a, Transform sig v) =>
(a -> a -> sig v -> v) -> sig a -> sig a -> sig v -> sig v
zipRangesWithTails a -> a -> sig v -> v
forall a v (sig :: * -> *).
(C a, C a v, Transform sig v) =>
a -> a -> sig v -> v
sumFromToFrac
(a -> sig a -> sig a
forall y. Storage (sig y) => y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
SigG.cons (a
da -> a -> a
forall a. C a => a -> a -> a
+a
1) sig a
ds) ((a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (a
1a -> a -> a
forall a. C a => a -> a -> a
+) sig a
ds) (sig v -> sig v) -> (sig v -> sig v) -> sig v -> sig v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
v -> sig v -> sig v
forall y. Storage (sig y) => y -> sig y -> sig y
forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
y -> sig y -> sig y
SigG.cons v
forall a. C a => a
zero
zipRangesWithTails ::
(SigG.Transform sig a, SigG.Transform sig v) =>
(a -> a -> sig v -> v) -> sig a -> sig a -> sig v -> sig v
zipRangesWithTails :: forall (sig :: * -> *) a v.
(Transform sig a, Transform sig v) =>
(a -> a -> sig v -> v) -> sig a -> sig a -> sig v -> sig v
zipRangesWithTails a -> a -> sig v -> v
f sig a
tls sig a
tus sig v
xs =
((a, sig v) -> a -> v) -> T (a, sig v) -> sig a -> sig v
forall (sig :: * -> *) b c a.
(Transform sig b, Transform sig c) =>
(a -> b -> c) -> T a -> sig b -> sig c
SigG.zipWithState
(\(a
tl,sig v
suffix) a
tu -> a -> a -> sig v -> v
f a
tl a
tu sig v
suffix)
(T a -> T (sig v) -> T (a, sig v)
forall a b. T a -> T b -> T (a, b)
SigS.zip (sig a -> T a
forall y. Storage (sig y) => sig y -> T y
forall (sig :: * -> *) y.
(Read0 sig, Storage (sig y)) =>
sig y -> T y
SigG.toState sig a
tls) (sig v -> T (sig v)
forall (sig :: * -> *) y. Transform sig y => sig y -> T (sig y)
SigG.tails sig v
xs))
sig a
tus
{-# INLINE sumsModulatedHalf #-}
sumsModulatedHalf ::
(RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
Int -> sig a -> sig v -> sig v
sumsModulatedHalf :: forall a v (sig :: * -> *).
(C a, C a v, Transform sig a, Write sig v) =>
Int -> sig a -> sig v -> sig v
sumsModulatedHalf Int
maxDInt sig a
ds sig v
xs =
let maxD :: a
maxD = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
maxDInt
d0 :: a
d0 = a
maxDa -> a -> a
forall a. C a => a -> a -> a
+a
0.5
delXs :: sig v
delXs = Int -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Write sig v) =>
Int -> sig v -> sig v
Delay.staticPos Int
maxDInt sig v
xs
posXs :: sig v
posXs = a -> sig a -> sig v -> sig v
forall a v (sig :: * -> *).
(C a, C a v, Transform sig a, Transform sig v) =>
a -> sig a -> sig v -> sig v
sumDiffsModulated a
d0 ((a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (a
d0a -> a -> a
forall a. C a => a -> a -> a
+) sig a
ds) sig v
delXs
negXs :: sig v
negXs = a -> sig a -> sig v -> sig v
forall a v (sig :: * -> *).
(C a, C a v, Transform sig a, Transform sig v) =>
a -> sig a -> sig v -> sig v
sumDiffsModulated a
d0 ((a -> a) -> sig a -> sig a
forall y0 y1.
(Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map (a
d0a -> a -> a
forall a. C a => a -> a -> a
-) sig a
ds) sig v
delXs
in sig v -> sig v
forall v (sig :: * -> *). (C v, Transform sig v) => sig v -> sig v
Integration.run (sig v -> sig v -> sig v
forall v (sig :: * -> *).
(C v, Transform sig v) =>
sig v -> sig v -> sig v
sub sig v
posXs sig v
negXs)
{-# INLINE modulatedFrac #-}
modulatedFrac ::
(RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
Int -> sig a -> sig v -> sig v
modulatedFrac :: forall a v (sig :: * -> *).
(C a, C a v, Transform sig a, Write sig v) =>
Int -> sig a -> sig v -> sig v
modulatedFrac Int
maxDInt sig a
ds sig v
xs =
(a -> v -> v) -> sig a -> sig v -> sig v
forall (sig :: * -> *) a b c.
(Read sig a, Transform sig b, Transform sig c) =>
(a -> b -> c) -> sig a -> sig b -> sig c
SigG.zipWith (\a
d v
y -> a -> a
forall a. C a => a -> a
recip (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
d) a -> v -> v
forall a v. C a v => a -> v -> v
*> v
y) sig a
ds (sig v -> sig v) -> sig v -> sig v
forall a b. (a -> b) -> a -> b
$
Int -> sig a -> sig v -> sig v
forall a v (sig :: * -> *).
(C a, C a v, Transform sig a, Write sig v) =>
Int -> sig a -> sig v -> sig v
sumsModulatedHalf Int
maxDInt sig a
ds sig v
xs