module Synthesizer.Dimensional.RateAmplitude.Piece (
   {- * Piecewise -}
   step, linear, exponential, cosine, halfSine, cubic,
   T, Sequence, run, runVolume, runState, runStateVolume,
   (-|#), ( #|-), (=|#), ( #|=), (|#), ( #|),  -- spaces before # for Haddock
   Piece.FlatPosition(..),
   ) where

import qualified Synthesizer.Generic.Piece as Piece
import qualified Synthesizer.Generic.Signal as SigG

import qualified Synthesizer.Piecewise as Piecewise
import Synthesizer.Piecewise ((-|#), ( #|-), (=|#), ( #|=), (|#), ( #|), )

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process
          (toTimeScalar, toGradientScalar, DimensionGradient, )
-- import Synthesizer.Dimensional.Process (($:), ($#), )

import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

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.Module             as Module
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 Control.Monad.Fix (mfix, )
import Control.Monad (liftM3, )

import NumericPrelude.Numeric (zero, )
import NumericPrelude.Base
import Prelude ()



type T s u v sig q =
   Piecewise.Piece
      (DN.T u q) (DN.T v q)
      (DN.T v q -> SigG.LazySize -> q ->
       Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Flat q) (sig q)))

type Sequence s u v sig q =
   Piecewise.T
      (DN.T u q) (DN.T v q)
      (DN.T v q -> SigG.LazySize -> q ->
       Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Flat q) (sig q)))


{- |
Since this function looks for the maximum node value,
and since the signal parameter inference phase must be completed before signal processing,
infinite descriptions cannot be used here.
-}
{-# INLINE run #-}
run :: (Trans.C q, RealRing.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
   DN.T u q ->
   Sequence s u v sig q ->
   Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Dimensional v q) (sig q))
run :: forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
run T u q
lazySize Sequence s u v sig q
cs =
   forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T v q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
runVolume T u q
lazySize Sequence s u v sig q
cs forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$
   forall a b. (a -> b) -> [a] -> [b]
map (\PieceData
  (T u q)
  (T v q)
  (T v q
   -> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c -> forall a. Ord a => a -> a -> a
max (forall u a. (C u, C a) => T u a -> T u a
DN.abs (forall t y sig. PieceData t y sig -> y
Piecewise.pieceY0 PieceData
  (T u q)
  (T v q)
  (T v q
   -> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c))
                  (forall u a. (C u, C a) => T u a -> T u a
DN.abs (forall t y sig. PieceData t y sig -> y
Piecewise.pieceY1 PieceData
  (T u q)
  (T v q)
  (T v q
   -> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c))) Sequence s u v sig q
cs


{-# INLINE runVolume #-}
runVolume ::
   (Trans.C q, RealRing.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
   DN.T u q ->
   Sequence s u v sig q ->
   DN.T v q ->
   Proc.T s u q (SigA.T (Rate.Phantom s) (Amp.Dimensional v q) (sig q))
runVolume :: forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T v q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
runVolume T u q
lazySize' Sequence s u v sig q
cs T v q
amplitude =
   -- it would be nice if we could re-use Piece.run
   do [q]
ts0 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t y sig. PieceData t y sig -> t
Piecewise.pieceDur) Sequence s u v sig q
cs
      Int
lazySize <-
         forall t u s. (C t, C u) => String -> T u t -> T s u t Int
Proc.intFromTime String
"Dimensional.Piece.runVolume" T u q
lazySize'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v q
amplitude forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sig. Monoid sig => [sig] -> sig
SigG.concat) forall a b. (a -> b) -> a -> b
$
         forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            (\(Int
n,q
t) (Piecewise.PieceData Piece
  (T u q)
  (T v q)
  (T v q
   -> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c T v q
yi0 T v q
yi1 T u q
d) ->
                 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall sig. Transform sig => Int -> sig -> sig
SigG.take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rate amplitude body. T rate amplitude body -> body
SigA.body) forall a b. (a -> b) -> a -> b
$
                 forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece Piece
  (T u q)
  (T v q)
  (T v q
   -> LazySize -> q -> T s u q (T (Phantom s) (Flat q) (sig q)))
c T v q
yi0 T v q
yi1 T u q
d T v q
amplitude (Int -> LazySize
SigG.LazySize Int
lazySize) q
t)
            (forall t. C t => [t] -> [(Int, t)]
Piecewise.splitDurations [q]
ts0)
            Sequence s u v sig q
cs


{-# INLINE runState #-}
runState :: (Trans.C q, RealRing.C q, Dim.C u, Dim.C v) =>
   Sequence s u v Sig.T q ->
   Proc.T s u q (SigA.R s v q q)
runState :: forall q u v s.
(C q, C q, C u, C v) =>
Sequence s u v T q -> T s u q (R s v q q)
runState = forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
run forall a. C a => a
zero


{-# INLINE runStateVolume #-}
runStateVolume ::
   (Trans.C q, RealRing.C q, Dim.C u, Dim.C v) =>
   Sequence s u v Sig.T q ->
   DN.T v q ->
   Proc.T s u q (SigA.R s v q q)
runStateVolume :: forall q u v s.
(C q, C q, C u, C v) =>
Sequence s u v T q -> T v q -> T s u q (R s v q q)
runStateVolume = forall q u v (sig :: * -> *) s.
(C q, C q, C u, C v, Write sig q) =>
T u q
-> Sequence s u v sig q
-> T v q
-> T s u q (T (Phantom s) (Dimensional v q) (sig q))
runVolume forall a. C a => a
zero


{-# INLINE toAmpScalar #-}
toAmpScalar ::
   (Field.C a, Dim.C u) =>
   DN.T u a -> DN.T u a -> a
toAmpScalar :: forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T u a
amp T u a
y =
   forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T u a
y T u a
amp

{-# INLINE make #-}
make :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
   Piece.T sig q -> T s u v sig q
make :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make T sig q
piece =
   forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ T v q
y0 T v q
y1 T u q
d T v q
amplitude LazySize
lazySize q
t0 ->
      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 t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
d) (\q
d' ->
         forall sig s y. sig -> T (Phantom s) (Flat y) sig
SigA.flatFromBody forall a b. (a -> b) -> a -> b
$
         forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece T sig q
piece
            (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y0)
            (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y1)
            q
d' LazySize
lazySize q
t0)

{-# INLINE step #-}
step :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q
step :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T s u v sig q
step =
   forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make forall (sig :: * -> *) a. Write sig a => T sig a
Piece.step

{-# INLINE linear #-}
linear :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q
linear :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T s u v sig q
linear =
   forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make forall a (sig :: * -> *). (C a, Write sig a) => T sig a
Piece.linear

{-# INLINE exponential #-}
exponential :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
   DN.T v q -> T s u v sig q
exponential :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T v q -> T s u v sig q
exponential T v q
saturation =
   forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ T v q
y0 T v q
y1 T u q
d T v q
amplitude LazySize
lazySize q
t0 ->
      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 t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
d) (\q
d' ->
         forall sig s y. sig -> T (Phantom s) (Flat y) sig
SigA.flatFromBody forall a b. (a -> b) -> a -> b
$
         forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece
            (forall a (sig :: * -> *). (C a, Write sig a) => a -> T sig a
Piece.exponential (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
saturation))
            (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y0)
            (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y1)
            q
d' LazySize
lazySize q
t0)

{-# INLINE cosine #-}
cosine :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) => T s u v sig q
cosine :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T s u v sig q
cosine =
   forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make forall a (sig :: * -> *). (C a, Write sig a) => T sig a
Piece.cosine

{-# INLINE halfSine #-}
halfSine :: (Trans.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
   Piece.FlatPosition -> T s u v sig q
halfSine :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
FlatPosition -> T s u v sig q
halfSine FlatPosition
pos =
   forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T sig q -> T s u v sig q
make (forall a (sig :: * -> *).
(C a, Write sig a) =>
FlatPosition -> T sig a
Piece.halfSine FlatPosition
pos)

{-# INLINE cubic #-}
cubic :: (Field.C q, Dim.C u, Dim.C v, SigG.Write sig q) =>
   DN.T (DimensionGradient u v) q ->
   DN.T (DimensionGradient u v) q ->
   T s u v sig q
cubic :: forall q u v (sig :: * -> *) s.
(C q, C u, C v, Write sig q) =>
T (DimensionGradient u v) q
-> T (DimensionGradient u v) q -> T s u v sig q
cubic T (DimensionGradient u v) q
yd0 T (DimensionGradient u v) q
yd1 =
   forall y t sig. (y -> y -> t -> sig) -> Piece t y sig
Piecewise.pieceFromFunction forall a b. (a -> b) -> a -> b
$ \ T v q
y0 T v q
y1 T u q
d T v q
amplitude LazySize
lazySize q
t0 ->
      forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (\q
d' q
yd0' q
yd1' ->
         forall sig s y. sig -> T (Phantom s) (Flat y) sig
SigA.flatFromBody forall a b. (a -> b) -> a -> b
$
            forall t y sig. Piece t y sig -> y -> y -> t -> sig
Piecewise.computePiece
               (forall a (sig :: * -> *). (C a, Write sig a) => a -> a -> T sig a
Piece.cubic q
yd0' q
yd1')
               (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y0)
               (forall a u. (C a, C u) => T u a -> T u a -> a
toAmpScalar T v q
amplitude T v q
y1)
               q
d' LazySize
lazySize q
t0)
         (forall t u s. (C t, C u) => T u t -> T s u t t
toTimeScalar T u q
d)
         (forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amplitude T (DimensionGradient u v) q
yd0)
         (forall q u v s.
(C q, C u, C v) =>
T v q -> T (DimensionGradient u v) q -> T s u q q
toGradientScalar T v q
amplitude T (DimensionGradient u v) q
yd1)