Cut.hs

{- |
This module allows abstraction of operations
that operate on the time axis
and do also work on signal types without sample values.
The most distinctive instances are certainly
Dirac signals and chunky time values.
-}
module Synthesizer.Generic.Cut where

import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.FusionList.Signal as SigFL
-- import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy as Vector

-- import qualified Algebra.ToInteger as ToInteger
-- import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Class as NonNeg
import qualified Numeric.NonNegative.Chunky as Chunky

import Foreign.Storable (Storable)

import Data.Function (fix, )
import qualified Data.List as List
import Data.Tuple.HT (mapPair, )
import qualified Data.Monoid as Monoid
import Data.Monoid (Monoid, )

import qualified Prelude as P
import NumericPrelude
import Prelude
   (Bool, Int, String, (++), error,
    pred, (<=), (>=), (<),
    (.), not, (||), (&&), )


class Read sig where
   null :: sig -> Bool
   length :: sig -> Int

class (Read sig, Monoid sig) => Transform sig where
   {- Monoid functions
   empty :: sig
   cycle :: sig -> sig
   append :: sig -> sig -> sig
   concat :: [sig] -> sig
   -}
   take :: Int -> sig -> sig
   drop :: Int -> sig -> sig
   -- can occur in an inner loop in Interpolation
   dropMarginRem :: Int -> Int -> sig -> (Int, sig)
   splitAt :: Int -> sig -> (sig, sig)
   reverse :: sig -> sig


-- instance Storable y => Read SigSt.T y where
instance Storable y => Read (Vector.Vector y) where
   {-# INLINE null #-}
   null = Vector.null
   {-# INLINE length #-}
   length = Vector.length

instance Storable y => Transform (Vector.Vector y) where
   {-
   {-# INLINE empty #-}
   empty = Vector.empty
   {-# INLINE cycle #-}
   cycle = Vector.cycle
   {-# INLINE append #-}
   append = Vector.append
   {-# INLINE concat #-}
   concat = Vector.concat
   -}
   {-# INLINE take #-}
   take = Vector.take
   {-# INLINE drop #-}
   drop = Vector.drop
   {-# INLINE splitAt #-}
   splitAt = Vector.splitAt
   {-# INLINE dropMarginRem #-}
   dropMarginRem = Vector.dropMarginRem
   {-# INLINE reverse #-}
   reverse = Vector.reverse


instance Read ([] y) where
   {-# INLINE null #-}
   null = List.null
   {-# INLINE length #-}
   length = List.length

instance Transform ([] y) where
   {-
   {-# INLINE empty #-}
   empty = []
   {-# INLINE cycle #-}
   cycle = List.cycle
   {-# INLINE append #-}
   append = (List.++)
   {-# INLINE concat #-}
   concat = List.concat
   -}
   {-# INLINE take #-}
   take = List.take
   {-# INLINE drop #-}
   drop = List.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem = Sig.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt = List.splitAt
   {-# INLINE reverse #-}
   reverse = List.reverse


instance Read (SigFL.T y) where
   {-# INLINE null #-}
   null = SigFL.null
   {-# INLINE length #-}
   length = SigFL.length

instance Transform (SigFL.T y) where
   {-
   {-# INLINE empty #-}
   empty = SigFL.empty
   {-# INLINE cycle #-}
   cycle = SigFL.cycle
   {-# INLINE append #-}
   append = SigFL.append
   {-# INLINE concat #-}
   concat = SigFL.concat
   -}

   {-# INLINE take #-}
   take = SigFL.take
   {-# INLINE drop #-}
   drop = SigFL.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem = SigFL.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt = SigFL.splitAt
   {-# INLINE reverse #-}
   reverse = SigFL.reverse


instance Read (SigS.T y) where
   {-# INLINE null #-}
   null = SigS.null
   {-# INLINE length #-}
   length = SigS.length

instance Transform (SigS.T y) where
   {-
   {-# INLINE empty #-}
   empty = SigS.empty
   {-# INLINE cycle #-}
   cycle = SigS.cycle
   {-# INLINE append #-}
   append = SigS.append
   {-# INLINE concat #-}
   concat = SigS.concat
   -}

   {-# INLINE take #-}
   take = SigS.take
   {-# INLINE drop #-}
   drop = SigS.drop
   {-# INLINE dropMarginRem #-}
   dropMarginRem = SigS.dropMarginRem
   {-# INLINE splitAt #-}
   splitAt n =
      -- This implementation is slow. Better leave it unimplemented?
      mapPair (SigS.fromList, SigS.fromList) .
      List.splitAt n . SigS.toList
   {-# INLINE reverse #-}
   reverse = SigS.reverse


{-
useful for application of non-negative chunky numbers as gate signals
-}
instance (P.Integral a) => Read (Chunky.T a) where
   {-# INLINE null #-}
   null = List.null . Chunky.toChunks
   {-# INLINE length #-}
   length = sum . List.map (P.fromIntegral . P.toInteger) . Chunky.toChunks


intToChunky :: (NonNeg.C a) => String -> Int -> Chunky.T a
intToChunky name =
   Chunky.fromNumber .
--   NonNegW.fromNumberMsg ("Generic.Cut."++name) .
   P.fromIntegral .
   (\x ->
      if x<0
        then error ("Generic.Cut.NonNeg.Chunky."++name++": negative argument")
        else x)

instance (P.Integral a, NonNeg.C a) => Transform (Chunky.T a) where
   {-# INLINE take #-}
   take n = P.min (intToChunky "take" n)
   {-# INLINE drop #-}
   drop n x = x NonNeg.-| intToChunky "drop" n
   {-# INLINE dropMarginRem #-}
   dropMarginRem n m x =
      let (z,d,b) =
             Chunky.minMaxDiff
                (intToChunky "dropMargin/n" n)
                (x NonNeg.-| intToChunky "dropMargin/m" m)
      in  (if b then 0 else P.fromIntegral (Chunky.toNumber d),
           x NonNeg.-| z)
   {-# INLINE splitAt #-}
   splitAt n x =
      let (z,d,b) = Chunky.minMaxDiff (intToChunky "splitAt" n) x
      in  (z, if b then d else Chunky.zero)
   {-# INLINE reverse #-}
   reverse = Chunky.fromChunks . P.reverse . Chunky.toChunks


{-# INLINE empty #-}
empty :: (Monoid sig) => sig
empty = Monoid.mempty

{-# INLINE cycle #-}
cycle :: (Monoid sig) => sig -> sig
cycle x = fix (append x)

{-# INLINE append #-}
append :: (Monoid sig) => sig -> sig -> sig
append = Monoid.mappend

{-# INLINE concat #-}
concat :: (Monoid sig) => [sig] -> sig
concat = Monoid.mconcat


{- |
Like @lengthAtLeast n xs  =  length xs >= n@,
but is more efficient, because it is more lazy.
-}
{-# INLINE lengthAtLeast #-}
lengthAtLeast :: (Transform sig) =>
   Int -> sig -> Bool
lengthAtLeast n xs =
   n<=0 || not (null (drop (pred n) xs))

{-# INLINE lengthAtMost #-}
lengthAtMost :: (Transform sig) =>
   Int -> sig -> Bool
lengthAtMost n xs =
   n>=0 && null (drop n xs)

{-# INLINE sliceVertical #-}
sliceVertical :: (Transform sig) =>
   Int -> sig -> SigS.T sig
sliceVertical n =
   SigS.map (take n) .
   SigS.takeWhile (not . null) .
   SigS.iterate (drop n)