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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Amplitude.Analysis (
    beginning, end,
    beginningPrimitive, endPrimitive,

    volumeMaximum,
    volumeEuclidean,
    volumeSum,
    volumeVectorMaximum,
    volumeVectorEuclidean,
    volumeVectorSum,

    directCurrentOffset,
    rectify,
    flipFlopHysteresis,

    compare,
    lessOrEqual,
  ) where

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Amplitude.Cut as CutD
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

import qualified Synthesizer.Generic.Signal as SigG

import qualified Synthesizer.State.Analysis as Ana
import qualified Synthesizer.State.Signal   as Sig
import Synthesizer.Plain.Analysis (BinaryLevel)

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

import Number.DimensionTerm ((*&))

import qualified Algebra.NormedSpace.Maximum   as NormedMax
import qualified Algebra.NormedSpace.Euclidean as NormedEuc
import qualified Algebra.NormedSpace.Sum       as NormedSum

import qualified Algebra.Algebraic           as Algebraic
import qualified Algebra.Module              as Module
import qualified Algebra.Field               as Field
import qualified Algebra.Absolute            as Absolute
import qualified Algebra.RealRing            as RealRing
import qualified Algebra.Ring                as Ring
import qualified Algebra.Additive            as Additive


import NumericPrelude.Base (Ord, Bool, (<=), ($), uncurry, )
-- import NumericPrelude.Numeric
import qualified Prelude as P



{- * Notions of volume -}

type SignalRateInd rate u y yv =
   SigA.T rate (Amp.Numeric (DN.T u y)) (Sig.T yv)

{-# INLINE beginning #-}
beginning ::
   (Ring.C y, Dim.C v, SigG.Transform sig y) =>
   SigA.T rate (Amp.Dimensional v y) (sig y) -> DN.T v y
beginning :: forall y v (sig :: * -> *) rate.
(C y, C v, Transform sig y) =>
T rate (Dimensional v y) (sig y) -> T v y
beginning T rate (Dimensional v y) (sig y)
sig =
   forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL
--      (error "Dimensional.Analysis.beginning: empty signal")
      forall a. C a => a
Additive.zero
      (\y
y sig y
_ -> forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale y
y forall a b. (a -> b) -> a -> b
$ forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude T rate (Dimensional v y) (sig y)
sig)
      (forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate (Dimensional v y) (sig y)
sig)

{-# INLINE end #-}
end ::
   (Ring.C y, Dim.C v, SigG.Transform sig y) =>
   SigA.T rate (Amp.Dimensional v y) (sig y) -> DN.T v y
end :: forall y v (sig :: * -> *) rate.
(C y, C v, Transform sig y) =>
T rate (Dimensional v y) (sig y) -> T v y
end T rate (Dimensional v y) (sig y)
sig =
   forall (sig :: * -> *) y a.
Transform sig y =>
a -> (sig y -> y -> a) -> sig y -> a
SigG.switchR
--      (error "Dimensional.Analysis.end: empty signal")
      forall a. C a => a
Additive.zero
      (\sig y
_ y
y -> forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale y
y forall a b. (a -> b) -> a -> b
$ forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude T rate (Dimensional v y) (sig y)
sig)
      (forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate (Dimensional v y) (sig y)
sig)


{-# INLINE beginningPrimitive #-}
beginningPrimitive ::
   (Amp.Primitive amp, SigG.Transform sig y) =>
   y -> SigA.T rate amp (sig y) -> y
beginningPrimitive :: forall amp (sig :: * -> *) y rate.
(Primitive amp, Transform sig y) =>
y -> T rate amp (sig y) -> y
beginningPrimitive y
deflt T rate amp (sig y)
sig =
   forall (sig :: * -> *) y a.
Transform sig y =>
a -> (y -> sig y -> a) -> sig y -> a
SigG.switchL
      y
deflt
      (\y
y sig y
_ -> y
y)
      (forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate amp (sig y)
sig)

{-# INLINE endPrimitive #-}
endPrimitive ::
   (Amp.Primitive amp, SigG.Transform sig y) =>
   y -> SigA.T rate amp (sig y) -> y
endPrimitive :: forall amp (sig :: * -> *) y rate.
(Primitive amp, Transform sig y) =>
y -> T rate amp (sig y) -> y
endPrimitive y
deflt T rate amp (sig y)
sig =
   forall (sig :: * -> *) y a.
Transform sig y =>
a -> (sig y -> y -> a) -> sig y -> a
SigG.switchR
      y
deflt
      (\sig y
_ y
y -> y
y)
      (forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate amp (sig y)
sig)


{- |
Volume based on Manhattan norm.
-}
{-# INLINE volumeMaximum #-}
volumeMaximum :: (RealRing.C y, Dim.C u) =>
   SignalRateInd rate u y y -> DN.T u y
volumeMaximum :: forall y u rate. (C y, C u) => SignalRateInd rate u y y -> T u y
volumeMaximum = forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y. C y => T y -> y
Ana.volumeMaximum

{- |
Volume based on Energy norm.
-}
{-# INLINE volumeEuclidean #-}
volumeEuclidean :: (Algebraic.C y, Dim.C u) =>
   SignalRateInd rate u y y -> DN.T u y
volumeEuclidean :: forall y u rate. (C y, C u) => SignalRateInd rate u y y -> T u y
volumeEuclidean = forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y. C y => T y -> y
Ana.volumeEuclidean

{- |
Volume based on Sum norm.
-}
{-# INLINE volumeSum #-}
volumeSum :: (Field.C y, Absolute.C y, Dim.C u) =>
   SignalRateInd rate u y y -> DN.T u y
volumeSum :: forall y u rate.
(C y, C y, C u) =>
SignalRateInd rate u y y -> T u y
volumeSum = forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y. (C y, C y) => T y -> y
Ana.volumeSum



{- |
Volume based on Manhattan norm.
-}
{-# INLINE volumeVectorMaximum #-}
volumeVectorMaximum :: (NormedMax.C y yv, Ord y, Dim.C u) =>
   SignalRateInd rate u y yv -> DN.T u y
volumeVectorMaximum :: forall y yv u rate.
(C y yv, Ord y, C u) =>
SignalRateInd rate u y yv -> T u y
volumeVectorMaximum = forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y yv. (C y yv, Ord y) => T yv -> y
Ana.volumeVectorMaximum

{- |
Volume based on Energy norm.
-}
{-# INLINE volumeVectorEuclidean #-}
volumeVectorEuclidean :: (NormedEuc.C y yv, Algebraic.C y, Dim.C u) =>
   SignalRateInd rate u y yv -> DN.T u y
volumeVectorEuclidean :: forall y yv u rate.
(C y yv, C y, C u) =>
SignalRateInd rate u y yv -> T u y
volumeVectorEuclidean = forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y yv. (C y, C y yv) => T yv -> y
Ana.volumeVectorEuclidean

{- |
Volume based on Sum norm.
-}
{-# INLINE volumeVectorSum #-}
volumeVectorSum :: (NormedSum.C y yv, Field.C y, Dim.C u) =>
   SignalRateInd rate u y yv -> DN.T u y
volumeVectorSum :: forall y yv u rate.
(C y yv, C y, C u) =>
SignalRateInd rate u y yv -> T u y
volumeVectorSum = forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y yv. (C y yv, C y) => T yv -> y
Ana.volumeVectorSum


{-# INLINE volumeAux #-}
volumeAux :: (Ring.C y, Dim.C u) =>
   (Sig.T yv -> y) -> SignalRateInd rate u y yv -> DN.T u y
volumeAux :: forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux T yv -> y
vol SignalRateInd rate u y yv
x =
   T yv -> y
vol (forall rate amplitude body. T rate amplitude body -> body
SigA.body SignalRateInd rate u y yv
x) forall u a. (C u, C a) => a -> T u a -> T u a
*& forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude SignalRateInd rate u y yv
x


{- * Miscellaneous -}

{- |
Requires finite length.
This is identical to the arithmetic mean.
-}
{-# INLINE directCurrentOffset #-}
directCurrentOffset :: (Field.C y, Dim.C u) =>
   SignalRateInd rate u y y -> DN.T u y
directCurrentOffset :: forall y u rate. (C y, C u) => SignalRateInd rate u y y -> T u y
directCurrentOffset =
   forall y u yv rate.
(C y, C u) =>
(T yv -> y) -> SignalRateInd rate u y yv -> T u y
volumeAux forall y. C y => T y -> y
Ana.directCurrentOffset

{-# INLINE rectify #-}
rectify :: (Absolute.C y) =>
   SigA.T rate amp (Sig.T y) -> SigA.T rate amp (Sig.T y)
rectify :: forall y rate amp. C y => T rate amp (T y) -> T rate amp (T y)
rectify = forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody forall y. C y => T y -> T y
Ana.rectify


{- |
Detect thresholds with a hysteresis.
-}
{-# INLINE flipFlopHysteresis #-}
flipFlopHysteresis :: (Ord y, Field.C y, Dim.C u) =>
   (DN.T u y, DN.T u y) -> BinaryLevel ->
   SignalRateInd rate u y y ->
   SigA.T rate Amp.Abstract (Sig.T BinaryLevel)
flipFlopHysteresis :: forall y u rate.
(Ord y, C y, C u) =>
(T u y, T u y)
-> BinaryLevel
-> SignalRateInd rate u y y
-> T rate Abstract (T BinaryLevel)
flipFlopHysteresis (T u y
lower,T u y
upper) BinaryLevel
start SignalRateInd rate u y y
x =
   let l :: y
l = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
SigA.toAmplitudeScalar SignalRateInd rate u y y
x T u y
lower
       h :: y
h = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
SigA.toAmplitudeScalar SignalRateInd rate u y y
x T u y
upper
   in  forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons (forall rate amplitude body. T rate amplitude body -> rate
SigA.sampleRate SignalRateInd rate u y y
x) Abstract
Amp.Abstract forall a b. (a -> b) -> a -> b
$
       forall y. Ord y => (y, y) -> BinaryLevel -> T y -> T BinaryLevel
Ana.flipFlopHysteresis (y
l,y
h) BinaryLevel
start forall a b. (a -> b) -> a -> b
$
       forall rate amplitude body. T rate amplitude body -> body
SigA.body SignalRateInd rate u y y
x


{- * comparison -}

{-# INLINE compare #-}
compare ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv, Ord yv) =>
   SigA.R s u y yv ->
   SigA.R s u y yv ->
   SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T P.Ordering)
compare :: forall y u yv s.
(Ord y, C y, C u, C y yv, Ord yv) =>
R s u y yv -> R s u y yv -> T (Phantom s) Abstract (T Ordering)
compare R s u y yv
x R s u y yv
y =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons forall s. Phantom s
Rate.Phantom Abstract
Amp.Abstract forall a b. (a -> b) -> a -> b
$
   forall a b. (a -> b) -> T a -> T b
Sig.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Ord a => a -> a -> Ordering
P.compare) forall a b. (a -> b) -> a -> b
$ forall rate amplitude body. T rate amplitude body -> body
SigA.body forall a b. (a -> b) -> a -> b
$ forall y u yv0 yv1 (sig :: * -> *) s.
(Ord y, C y, C u, C y yv0, C y yv1, Read sig yv0,
 Transform sig yv1, Transform sig (yv0, yv1)) =>
Signal s u y sig yv0
-> Signal s u y sig yv1 -> Signal s u y sig (yv0, yv1)
CutD.zip R s u y yv
x R s u y yv
y

{-# INLINE lessOrEqual #-}
lessOrEqual ::
   (Ord y, Field.C y, Dim.C u,
    Module.C y yv, Ord yv) =>
   SigA.R s u y yv ->
   SigA.R s u y yv ->
   SigA.T (Rate.Phantom s) Amp.Abstract (Sig.T Bool)
lessOrEqual :: forall y u yv s.
(Ord y, C y, C u, C y yv, Ord yv) =>
R s u y yv -> R s u y yv -> T (Phantom s) Abstract (T Bool)
lessOrEqual R s u y yv
x R s u y yv
y =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall a b. (a -> b) -> T a -> T b
Sig.map (forall a. Ord a => a -> a -> Bool
<= Ordering
P.EQ)) forall a b. (a -> b) -> a -> b
$ forall y u yv s.
(Ord y, C y, C u, C y yv, Ord yv) =>
R s u y yv -> R s u y yv -> T (Phantom s) Abstract (T Ordering)
compare R s u y yv
x R s u y yv
y