{- |
Copyright   :  (c) Henning Thielemann 2011
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Causal.Analysis (
   deltaSigmaModulationPositive,
   ) where

import qualified Synthesizer.Causal.Analysis as Ana
import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNR

import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Sample as Sample
import qualified Synthesizer.Dimensional.Amplitude as Amp

import qualified Synthesizer.Dimensional.Causal.Process as CausalD

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim
import Number.DimensionTerm ((&*&), )

import qualified Algebra.Field          as Field
import qualified Algebra.RealRing       as RealRing

import Control.Arrow (second, (<<<), )

import NumericPrelude.Base
-- import NumericPrelude.Numeric
import Prelude ()


type DNS v y yv = Sample.Dimensional v y yv



deltaSigmaModulationPositive ::
   (RealRing.C a, Field.C a, Dim.C u, Dim.C v) =>
   Proc.T s u a (CausalD.T s (DNS (Dim.Mul u v) a a, DNS v a a) (DNS v a a))
deltaSigmaModulationPositive :: forall a u v s.
(C a, C a, C u, C v) =>
T s u a (T s (DNS (Mul u v) a a, DNS v a a) (DNS v a a))
deltaSigmaModulationPositive =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall u s t. C u => T s u t (T (Recip u) t)
Proc.getSampleRate forall a b. (a -> b) -> a -> b
$ \T (Recip u) a
rate ->
      forall sample0 sample1 s.
(Amplitude sample0
 -> (Amplitude sample1,
     T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \ (Amp.Numeric T (Mul u v) a
thresholdAmp, Amp.Numeric T v a
inputAmp) ->
         let targetAmp :: T v a
targetAmp =
                forall u v a. (C u, C v) => (u -> v) -> T u a -> T v a
DN.rewriteDimension
                   (forall u. C u => Mul Scalar u -> u
Dim.identityLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall u0 u1 v.
(C u0, C u1, C v) =>
(u0 -> u1) -> Mul u0 v -> Mul u1 v
Dim.applyLeftMul forall u. C u => Mul (Recip u) u -> Scalar
Dim.cancelLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall u0 u1 u2.
(C u0, C u1, C u2) =>
Mul u0 (Mul u1 u2) -> Mul (Mul u0 u1) u2
Dim.associateLeft) forall a b. (a -> b) -> a -> b
$
                T (Recip u) a
rate forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& T (Mul u v) a
thresholdAmp
             ampRatio :: a
ampRatio = forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v a
inputAmp T v a
targetAmp
         in  (forall amp. amp -> Numeric amp
Amp.Numeric T v a
targetAmp,
              forall y. C y => T (y, y) y
Ana.deltaSigmaModulationPositive
              forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
              forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. C a => a -> T a a
FiltNR.amplify a
ampRatio))