{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Copyright   :  (c) Henning Thielemann 2009
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Map.Filter (
   -- * Amplification
   amplify,
   amplifyDimension,
   amplifyScalarDimension,
   negate,
   envelope,
   envelopeScalarDimension,
   envelopeVector,
   envelopeVectorDimension,
 ) where

import qualified Synthesizer.Dimensional.Map as MapD
import qualified Synthesizer.Dimensional.Arrow as ArrowD
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Sample as Sample

import Control.Arrow (Arrow, )

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

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

-- import qualified Number.NonNegative     as NonNeg

-- import qualified Algebra.Transcendental as Trans
-- import qualified Algebra.RealRing      as RealRing
-- import qualified Algebra.Field          as Field
-- import qualified Algebra.Absolute           as Absolute
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive
-- import qualified Algebra.VectorSpace    as VectorSpace
import qualified Algebra.Module         as Module

-- import Control.Monad(liftM2)

import NumericPrelude.Numeric hiding (negate)
import NumericPrelude.Base as P
import Prelude ()


{- | The amplification factor must be positive. -}
{-# INLINE amplify #-}
amplify ::
   (Module.C y amp, Arrow arrow) =>
   y ->
   ArrowD.Single arrow (Amp.Numeric amp) (Amp.Numeric amp) yv yv
amplify :: forall y amp (arrow :: * -> * -> *) yv.
(C y amp, Arrow arrow) =>
y -> Single arrow (Numeric amp) (Numeric amp) yv yv
amplify y
volume =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (y
volume forall a v. C a v => a -> v -> v
*>)) forall a. a -> a
id

{-# INLINE amplifyDimension #-}
amplifyDimension ::
   (Ring.C y, Dim.C v0, Dim.C v1, Arrow arrow) =>
   DN.T v0 y ->
   ArrowD.Single arrow
      (Amp.Dimensional v1 y) (Amp.Dimensional (Dim.Mul v0 v1) y)
      yv yv
amplifyDimension :: forall y v0 v1 (arrow :: * -> * -> *) yv.
(C y, C v0, C v1, Arrow arrow) =>
T v0 y
-> Single
     arrow (Dimensional v1 y) (Dimensional (Mul v0 v1) y) yv yv
amplifyDimension T v0 y
volume =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T v0 y
volume forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*&)) forall a. a -> a
id

{-# INLINE amplifyScalarDimension #-}
amplifyScalarDimension ::
   (Ring.C y, Dim.C v, Arrow arrow) =>
   DN.T v y ->
   ArrowD.Single arrow
      (Amp.Dimensional Dim.Scalar y) (Amp.Dimensional v y)
      yv yv
amplifyScalarDimension :: forall y v (arrow :: * -> * -> *) yv.
(C y, C v, Arrow arrow) =>
T v y
-> Single arrow (Dimensional Scalar y) (Dimensional v y) yv yv
amplifyScalarDimension T v y
volume =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent 
      (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale T v y
volume forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scalar a -> a
DN.toNumber)
      forall a. a -> a
id


{-# INLINE negate #-}
negate ::
   (Additive.C (Sample.Displacement sample), Arrow arrow) =>
   ArrowD.T arrow sample sample
negate :: forall sample (arrow :: * -> * -> *).
(C (Displacement sample), Arrow arrow) =>
T arrow sample sample
negate =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent forall a. a -> a
id forall a. C a => a -> a
Additive.negate


{-# INLINE envelope #-}
envelope ::
   (Ring.C y, Arrow arrow) =>
   ArrowD.T arrow (Sample.Flat y, Sample.Numeric amp y) (Sample.Numeric amp y)
envelope :: forall y (arrow :: * -> * -> *) amp.
(C y, Arrow arrow) =>
T arrow (Flat y, Numeric amp y) (Numeric amp y)
envelope =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent forall a b. (a, b) -> b
snd (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. C a => a -> a -> a
(*))

{-# INLINE envelopeScalarDimension #-}
envelopeScalarDimension ::
   (Ring.C y, Dim.C v, Arrow arrow) =>
   ArrowD.T arrow
      (Sample.Dimensional Dim.Scalar y y, Sample.Dimensional v y y)
      (Sample.Dimensional v y y)
envelopeScalarDimension :: forall y v (arrow :: * -> * -> *).
(C y, C v, Arrow arrow) =>
T arrow
  (Dimensional Scalar y y, Dimensional v y y)
  (Dimensional v y y)
envelopeScalarDimension =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent
      (\(Amp.Numeric Scalar y
ampEnv, Amp.Numeric T v y
ampSig) ->
         forall amp. amp -> Numeric amp
Amp.Numeric forall a b. (a -> b) -> a -> b
$ forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale (forall a. Scalar a -> a
DN.toNumber Scalar y
ampEnv) T v y
ampSig)
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. C a => a -> a -> a
(*))

{-# INLINE envelopeVector #-}
envelopeVector ::
   (Module.C y (Sample.Displacement sample), Arrow arrow) =>
   ArrowD.T arrow (Sample.Flat y, sample) sample
envelopeVector :: forall y sample (arrow :: * -> * -> *).
(C y (Displacement sample), Arrow arrow) =>
T arrow (Flat y, sample) sample
envelopeVector =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent forall a b. (a, b) -> b
snd (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a v. C a v => a -> v -> v
(*>))

{-# INLINE envelopeVectorDimension #-}
envelopeVectorDimension ::
   (Module.C y0 yv, Ring.C y, Dim.C v0, Dim.C v1, Arrow arrow) =>
   ArrowD.T arrow
      (Sample.Dimensional v0 y y0, Sample.Dimensional v1 y yv)
      (Sample.Dimensional (Dim.Mul v0 v1) y yv)
envelopeVectorDimension :: forall y0 yv y v0 v1 (arrow :: * -> * -> *).
(C y0 yv, C y, C v0, C v1, Arrow arrow) =>
T arrow
  (Dimensional v0 y y0, Dimensional v1 y yv)
  (Dimensional (Mul v0 v1) y yv)
envelopeVectorDimension =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent
      (\(Amp.Numeric T v0 y
ampEnv, Amp.Numeric T v1 y
ampSig) ->
         forall amp. amp -> Numeric amp
Amp.Numeric forall a b. (a -> b) -> a -> b
$ T v0 y
ampEnv forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& T v1 y
ampSig)
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a v. C a v => a -> v -> v
(*>))