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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.RateAmplitude.Analysis (
    AnaR.centroid,
    AnaR.length,
    AnaA.beginning,
    AnaA.end,

    normMaximum,      normVectorMaximum,
    normEuclideanSqr, normVectorEuclideanSqr,
    normSum,          normVectorSum,

    normMaximumProc,      normVectorMaximumProc,
    normEuclideanSqrProc, normVectorEuclideanSqrProc,
    normSumProc,          normVectorSumProc,

    histogram,
    zeros,
  ) where

import qualified Synthesizer.State.Analysis as Ana
import qualified Synthesizer.State.Signal   as Sig

import qualified Synthesizer.Dimensional.Amplitude.Analysis   as AnaA
import qualified Synthesizer.Dimensional.Rate.Analysis        as AnaR
import qualified Synthesizer.Dimensional.Amplitude            as Amp
import qualified Synthesizer.Dimensional.Rate                 as Rate
import qualified Synthesizer.Dimensional.Process              as Proc
import qualified Synthesizer.Dimensional.Signal.Private       as SigA
import qualified Synthesizer.Dimensional.Rate.Dirac           as Dirac

import Synthesizer.Dimensional.Process (DimensionGradient, )

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

import Number.DimensionTerm ((&*&), (*&), )

-- import qualified Number.Complex as Complex

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

-- import qualified Algebra.Transcendental      as Trans
import qualified Algebra.Algebraic           as Algebraic
import qualified Algebra.RealField           as RealField
import qualified Algebra.Field               as Field
import qualified Algebra.RealRing            as RealRing
import qualified Algebra.Ring                as Ring
import qualified Algebra.Absolute            as Absolute


import NumericPrelude.Base (Ord, ($), (.), return, fmap, id, )
import NumericPrelude.Numeric (sqr, abs, )
import Prelude (Int, )


{- * Norms -}

type Signal u t v y yv =
   SigA.T (Rate.Dimensional u t) (Amp.Dimensional v y) (Sig.T yv)


{- |
Manhattan norm.
-}
{-# INLINE normMaximum #-}
normMaximum :: (RealRing.C y, Dim.C u, Dim.C v) =>
   Signal u t v y y -> DN.T v y
normMaximum :: forall y u v t. (C y, C u, C v) => Signal u t v y y -> T v y
normMaximum =
   forall y u rate. (C y, C u) => SignalRateInd rate u y y -> T u y
AnaA.volumeMaximum

{- |
Square of energy norm.

Could also be called @variance@.
-}
{-# INLINE normEuclideanSqr #-}
normEuclideanSqr :: (Algebraic.C q, Dim.C u, Dim.C v) =>
   Signal u q v q q ->
   DN.T (Dim.Mul u (Dim.Sqr v)) q
normEuclideanSqr :: forall q u v.
(C q, C u, C v) =>
Signal u q v q q -> T (Mul u (Sqr v)) q
normEuclideanSqr =
   forall v0 v1 u t y yv.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> Signal u t v0 y yv -> T (Mul u v1) t
normAux forall u a. (C u, C a) => T u a -> T (Sqr u) a
DN.sqr (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a. C a => a -> a
sqr)

{- |
Sum norm.
-}
{-# INLINE normSum #-}
normSum :: (Field.C q, Absolute.C q, Dim.C u, Dim.C v) =>
   Signal u q v q q ->
   DN.T (Dim.Mul u v) q
normSum :: forall q u v.
(C q, C q, C u, C v) =>
Signal u q v q q -> T (Mul u v) q
normSum =
   forall v0 v1 u t y yv.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> Signal u t v0 y yv -> T (Mul u v1) t
normAux forall a. a -> a
id (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a. C a => a -> a
abs)



{- |
Manhattan norm.
-}
{-# INLINE normVectorMaximum #-}
normVectorMaximum ::
   (NormedMax.C q yv, Ord q, Dim.C u, Dim.C v) =>
   Signal u q v q yv ->
   DN.T v q
normVectorMaximum :: forall q yv u v.
(C q yv, Ord q, C u, C v) =>
Signal u q v q yv -> T v q
normVectorMaximum =
   forall y yv u rate.
(C y yv, Ord y, C u) =>
SignalRateInd rate u y yv -> T u y
AnaA.volumeVectorMaximum -- NormedMax.norm

{- |
Energy norm.
-}
{-# INLINE normVectorEuclideanSqr #-}
normVectorEuclideanSqr ::
   (NormedEuc.C q yv, Algebraic.C q, Dim.C u, Dim.C v) =>
   Signal u q v q yv ->
   DN.T (Dim.Mul u (Dim.Sqr v)) q
normVectorEuclideanSqr :: forall q yv u v.
(C q yv, C q, C u, C v) =>
Signal u q v q yv -> T (Mul u (Sqr v)) q
normVectorEuclideanSqr =
   forall v0 v1 u t y yv.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> Signal u t v0 y yv -> T (Mul u v1) t
normAux forall u a. (C u, C a) => T u a -> T (Sqr u) a
DN.sqr (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a v. Sqr a v => v -> a
NormedEuc.normSqr)

{- |
Sum norm.
-}
{-# INLINE normVectorSum #-}
normVectorSum ::
   (NormedSum.C q yv, Field.C q, Dim.C u, Dim.C v) =>
   Signal u q v q yv ->
   DN.T (Dim.Mul u v) q
normVectorSum :: forall q yv u v.
(C q yv, C q, C u, C v) =>
Signal u q v q yv -> T (Mul u v) q
normVectorSum =
   forall v0 v1 u t y yv.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> Signal u t v0 y yv -> T (Mul u v1) t
normAux forall a. a -> a
id (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a v. C a v => v -> a
NormedSum.norm)


{-# INLINE normAux #-}
normAux :: (Dim.C v0, Dim.C v1, Dim.C u, Field.C t) =>
   (DN.T v0 y -> DN.T v1 t) ->
   (Sig.T yv -> t) ->
   Signal u t v0 y yv ->
   DN.T (Dim.Mul u v1) t
normAux :: forall v0 v1 u t y yv.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> Signal u t v0 y yv -> T (Mul u v1) t
normAux T v0 y -> T v1 t
amp T yv -> t
norm Signal u t v0 y yv
x =
   T yv -> t
norm (forall rate amplitude body. T rate amplitude body -> body
SigA.body Signal u t v0 y yv
x)
       forall u a. (C u, C a) => a -> T u a -> T u a
*& forall u a. (C u, C a) => T (Recip u) a -> T u a
DN.unrecip (forall rate amp sig. T (Actual rate) amp sig -> rate
SigA.actualSampleRate Signal u t v0 y yv
x)
      forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& T v0 y -> T v1 t
amp (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude Signal u t v0 y yv
x)




{-# DEPRECATED #-}
{- |
Manhattan norm.
-}
{-# INLINE normMaximumProc #-}
normMaximumProc :: (RealRing.C y, Dim.C u, Dim.C v) =>
   Proc.T s u y (SigA.R s v y y -> DN.T v y)
normMaximumProc :: forall y u v s. (C y, C u, C v) => T s u y (R s v y y -> T v y)
normMaximumProc =
   forall a s u t. a -> T s u t a
Proc.pure forall y u rate. (C y, C u) => SignalRateInd rate u y y -> T u y
AnaA.volumeMaximum

{-# DEPRECATED #-}
{- |
Square of energy norm.

Could also be called @variance@.
-}
{-# INLINE normEuclideanSqrProc #-}
normEuclideanSqrProc :: (Algebraic.C q, Dim.C u, Dim.C v) =>
   Proc.T s u q (
      SigA.R s v q q ->
      DN.T (Dim.Mul u (Dim.Sqr v)) q)
normEuclideanSqrProc :: forall q u v s.
(C q, C u, C v) =>
T s u q (R s v q q -> T (Mul u (Sqr v)) q)
normEuclideanSqrProc =
   forall v0 v1 u t y yv s.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> T s u t (R s v0 y yv -> T (Mul u v1) t)
normAuxProc forall u a. (C u, C a) => T u a -> T (Sqr u) a
DN.sqr (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a. C a => a -> a
sqr)

{-# DEPRECATED #-}
{- |
Sum norm.
-}
{-# INLINE normSumProc #-}
normSumProc :: (Field.C q, Absolute.C q, Dim.C u, Dim.C v) =>
   Proc.T s u q (
      SigA.R s v q q ->
      DN.T (Dim.Mul u v) q)
normSumProc :: forall q u v s.
(C q, C q, C u, C v) =>
T s u q (R s v q q -> T (Mul u v) q)
normSumProc =
   forall v0 v1 u t y yv s.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> T s u t (R s v0 y yv -> T (Mul u v1) t)
normAuxProc forall a. a -> a
id (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a. C a => a -> a
abs)



{-# DEPRECATED #-}
{- |
Manhattan norm.
-}
{-# INLINE normVectorMaximumProc #-}
normVectorMaximumProc ::
   (NormedMax.C y yv, Ord y, Dim.C u, Dim.C v) =>
   Proc.T s u y (
      SigA.R s v y yv ->
      DN.T v y)
normVectorMaximumProc :: forall y yv u v s.
(C y yv, Ord y, C u, C v) =>
T s u y (R s v y yv -> T v y)
normVectorMaximumProc =
   forall a s u t. a -> T s u t a
Proc.pure forall y yv u rate.
(C y yv, Ord y, C u) =>
SignalRateInd rate u y yv -> T u y
AnaA.volumeVectorMaximum -- NormedMax.norm

{-# DEPRECATED #-}
{- |
Energy norm.
-}
{-# INLINE normVectorEuclideanSqrProc #-}
normVectorEuclideanSqrProc ::
   (NormedEuc.C y yv, Algebraic.C y, Dim.C u, Dim.C v) =>
   Proc.T s u y (
      SigA.R s v y yv ->
      DN.T (Dim.Mul u (Dim.Sqr v)) y)
normVectorEuclideanSqrProc :: forall y yv u v s.
(C y yv, C y, C u, C v) =>
T s u y (R s v y yv -> T (Mul u (Sqr v)) y)
normVectorEuclideanSqrProc =
   forall v0 v1 u t y yv s.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> T s u t (R s v0 y yv -> T (Mul u v1) t)
normAuxProc forall u a. (C u, C a) => T u a -> T (Sqr u) a
DN.sqr (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a v. Sqr a v => v -> a
NormedEuc.normSqr)

{-# DEPRECATED #-}
{- |
Sum norm.
-}
{-# INLINE normVectorSumProc #-}
normVectorSumProc ::
   (NormedSum.C y yv, Field.C y, Dim.C u, Dim.C v) =>
   Proc.T s u y (
      SigA.R s v y yv ->
      DN.T (Dim.Mul u v) y)
normVectorSumProc :: forall y yv u v s.
(C y yv, C y, C u, C v) =>
T s u y (R s v y yv -> T (Mul u v) y)
normVectorSumProc =
   forall v0 v1 u t y yv s.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> T s u t (R s v0 y yv -> T (Mul u v1) t)
normAuxProc forall a. a -> a
id (forall a. C a => T a -> a
Sig.sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> T a -> T b
Sig.map forall a v. C a v => v -> a
NormedSum.norm)


{-# INLINE normAuxProc #-}
normAuxProc :: (Dim.C v0, Dim.C v1, Dim.C u, Field.C t) =>
   (DN.T v0 y -> DN.T v1 t) ->
   (Sig.T yv -> t) ->
   Proc.T s u t (
      SigA.R s v0 y yv ->
      DN.T (Dim.Mul u v1) t)
normAuxProc :: forall v0 v1 u t y yv s.
(C v0, C v1, C u, C t) =>
(T v0 y -> T v1 t)
-> (T yv -> t) -> T s u t (R s v0 y yv -> T (Mul u v1) t)
normAuxProc T v0 y -> T v1 t
amp T yv -> t
norm =
   forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall a b. (a -> b) -> a -> b
$ \ R s v0 y yv
x ->
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& T v0 y -> T v1 t
amp (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s v0 y yv
x))
      (forall t u s. (C t, C u) => t -> T s u t (T u t)
Proc.toTimeDimension (T yv -> t
norm (forall rate amplitude body. T rate amplitude body -> body
SigA.body R s v0 y yv
x)))





{- * Miscellaneous -}

{-# INLINE histogram #-}
histogram :: (RealField.C q, Dim.C u, Dim.C v) =>
   Signal u q v q q ->
   Proc.T s v q (Int, SigA.R s (DimensionGradient v u) q q)
histogram :: forall q u v s.
(C q, C u, C v) =>
Signal u q v q q -> T s v q (Int, R s (DimensionGradient v u) q q)
histogram Signal u q v q q
xs =
   do T (Recip v) q
rateY <- forall u s t. C u => T s u t (T (Recip u) t)
Proc.getSampleRate
      T v q -> q
toTime <- forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T u t -> T s u t t
Proc.toTimeScalar
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
         let (Int
offset, T q
hist) =
                 forall y. C y => T y -> (Int, T y)
Ana.histogramLinearIntMap
                    (forall y (sig :: * -> *) amp rate.
(C y, Transform sig y) =>
(amp -> y) -> T rate (Numeric amp) (sig y) -> sig y
SigA.scalarSamples T v q -> q
toTime Signal u q v q q
xs)
         in  (Int
offset,
              forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody
                 (T (Recip v) q
rateY forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& forall u a. (C u, C a) => T (Recip u) a -> T u a
DN.unrecip (forall rate amp sig. T (Actual rate) amp sig -> rate
SigA.actualSampleRate Signal u q v q q
xs))
                 T q
hist)

{- |
Detects zeros (sign changes) in a signal.
This can be used as a simple measure of the portion
of high frequencies or noise in the signal.
The result has a frequency as amplitude.
If you smooth it, you will get a curve that represents a frequency progress.
It ca be used as voiced\/unvoiced detector in a vocoder.

The result will be one value shorter than the input.
-}
{-# INLINE zeros #-}
zeros :: (Ord q, Ring.C q, Dim.C u, Dim.C v) =>
   Proc.T s u q (SigA.R s v q q -> SigA.R s (Dim.Recip u) q q)
zeros :: forall q u v s.
(Ord q, C q, C u, C v) =>
T s u q (R s v q q -> R s (Recip u) q q)
zeros =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\T s T -> R s (Recip u) q q
fp -> T s T -> R s (Recip u) q q
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (sig :: * -> *). sig Bool -> T s sig
Dirac.Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. (Ord y, C y) => T y -> T Bool
Ana.zeros forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rate amplitude body. T rate amplitude body -> body
SigA.body)
      forall q u (sig :: * -> *) s.
(C q, C u, Functor sig) =>
T s
  u
  q
  (T s sig -> T (Phantom s) (Numeric (T (Recip u) q)) (sig q))
Dirac.toAmplitudeSignal