Analysis.hs

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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Amplitude.Analysis (
    volumeMaximum,
    volumeEuclidean,
    volumeSum,
    volumeVectorMaximum,
    volumeVectorEuclidean,
    volumeVectorSum,

    directCurrentOffset,
    rectify,
    flipFlopHysteresis,

    compare,
    lessOrEqual,
  ) where

import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind
import qualified Synthesizer.Dimensional.Abstraction.Homogeneous as Hom

-- import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.Straight.Signal as SigS

import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Amplitude.Cut    as CutD
-- import Synthesizer.Dimensional.Amplitude.Signal (toAmplitudeScalar)

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

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.Real                as Real
import qualified Algebra.Ring                as Ring


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



{- * Notions of volume -}

{- |
Volume based on Manhattan norm.
-}
{-# INLINE volumeMaximum #-}
volumeMaximum :: (Ind.C w, Real.C y, Dim.C u) =>
   w (SigA.S u y) y -> DN.T u y
volumeMaximum = volumeAux Ana.volumeMaximum

{- |
Volume based on Energy norm.
-}
{-# INLINE volumeEuclidean #-}
volumeEuclidean :: (Ind.C w, Algebraic.C y, Dim.C u) =>
   w (SigA.S u y) y -> DN.T u y
volumeEuclidean = volumeAux Ana.volumeEuclidean

{- |
Volume based on Sum norm.
-}
{-# INLINE volumeSum #-}
volumeSum :: (Ind.C w, Field.C y, Real.C y, Dim.C u) =>
   w (SigA.S u y) y -> DN.T u y
volumeSum = volumeAux Ana.volumeSum



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

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

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


{-# INLINE volumeAux #-}
volumeAux :: (Ind.C w, Ring.C y, Dim.C u) =>
   (Sig.T yv -> y) -> w (SigA.S u y) yv -> DN.T u y
volumeAux vol x =
   vol (SigA.samples x) *& SigA.amplitude x


{- * Miscellaneous -}

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

{-# INLINE rectify #-}
rectify :: (Ind.C w, Hom.C sig, Real.C y) =>
   w sig y -> w sig y
rectify = Ind.processSignal (Hom.unwrappedProcessSamples Ana.rectify)


{- |
Detect thresholds with a hysteresis.
-}
{-# INLINE flipFlopHysteresis #-}
flipFlopHysteresis :: (Ind.C w, Ord y, Field.C y, Dim.C u) =>
   (DN.T u y, DN.T u y) -> Bool ->
   w (SigA.S u y) y -> w SigS.S Bool
--   SigA.R s u y y -> SigS.Binary s
flipFlopHysteresis (lower,upper) start x =
   let l = SigA.toAmplitudeScalar x lower
       h = SigA.toAmplitudeScalar x upper
   in  Ind.processSignal
          (SigS.Cons .
           Ana.flipFlopHysteresis (l,h) start .
           SigA.privateSamples) 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 -> SigS.R s P.Ordering
compare x y =
   SigS.fromSamples $ Sig.map (uncurry P.compare) $ SigA.samples $ CutD.zip x 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 -> SigS.Binary s
lessOrEqual x y =
   P.fmap (<= P.EQ) $ compare x y