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
sumsStaticInt :: (Additive.C v, SigG.Write sig v) =>
Int -> sig v -> sig v
sumsStaticInt n xs =
Integration.run (sub xs (Delay.staticPos n xs))
sub :: (Additive.C v, SigG.Transform sig v) =>
sig v -> sig v -> sig v
sub xs ys =
SigG.mix xs (SigG.map Additive.negate ys)
sumFromToFrac ::
(RealField.C a, Module.C a v, SigG.Transform sig v) =>
a -> a -> sig v -> v
sumFromToFrac from to xs =
let (fromInt, fromFrac) = splitFraction from
(toInt, toFrac) = splitFraction to
in case compare fromInt toInt of
EQ -> (tofrom) *> index zero fromInt xs
LT ->
(addNext ((1fromFrac) *>) $
nest (toIntfromInt1) (addNext id) $
addNext (toFrac *>) $
const)
zero (SigG.drop fromInt xs)
GT ->
(addNext ((1toFrac) *>) $
nest (fromInttoInt1) (addNext id) $
addNext (fromFrac *>) $
const)
zero (SigG.drop toInt xs)
index ::
(SigG.Transform sig y) =>
y -> Int -> sig y -> y
index deflt n =
maybe deflt fst . SigG.viewL . SigG.drop n
addNext ::
(Additive.C v, SigG.Transform sig a) =>
(a -> v) -> (v -> sig a -> v) -> v -> sig a -> v
addNext f next s =
SigG.switchL s
(\y ys -> next (s + f y) ys)
sumDiffsModulated ::
(RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Transform sig v) =>
a -> sig a -> sig v -> sig v
sumDiffsModulated d ds =
maybe (error "MovingAverage: signal must be non-empty because we prepended a zero before") fst .
SigG.viewR .
zipRangesWithTails sumFromToFrac
(SigG.cons (d+1) ds) (SigG.map (1+) ds) .
SigG.cons zero
zipRangesWithTails ::
(SigG.Transform sig a, SigG.Transform sig v) =>
(a -> a -> sig v -> v) -> sig a -> sig a -> sig v -> sig v
zipRangesWithTails f tls tus xs =
SigG.zipWithState
(\(tl,suffix) tu -> f tl tu suffix)
(SigS.zip (SigG.toState tls) (SigG.tails xs))
tus
sumsModulatedHalf ::
(RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
Int -> sig a -> sig v -> sig v
sumsModulatedHalf maxDInt ds xs =
let maxD = fromIntegral maxDInt
d0 = maxD+0.5
delXs = Delay.staticPos maxDInt xs
posXs = sumDiffsModulated d0 (SigG.map (d0+) ds) delXs
negXs = sumDiffsModulated d0 (SigG.map (d0) ds) delXs
in Integration.run (sub posXs negXs)
modulatedFrac ::
(RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
Int -> sig a -> sig v -> sig v
modulatedFrac maxDInt ds xs =
SigG.zipWith (\d y -> recip (2*d) *> y) ds $
sumsModulatedHalf maxDInt ds xs