synthesizer-core-0.3: src/Synthesizer/Generic/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 Algebra.Ring as Ring
-- import qualified Number.NonNegative as NonNegW
import qualified Algebra.NonNegative as NonNeg
import qualified Number.NonNegativeChunky as Chunky
-- import qualified Numeric.NonNegative.Wrapper as NonNegW98
import qualified Numeric.NonNegative.Class as NonNeg98
import qualified Numeric.NonNegative.Chunky as Chunky98
import Foreign.Storable (Storable)
import qualified Data.List as List
import Data.Function (fix, )
import Data.Tuple.HT (mapPair, )
import qualified Data.Monoid as Monoid
import Data.Monoid (Monoid, mempty, )
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 (ToInteger.C a, NonNeg.C a) => Read (Chunky.T a) where
{-# INLINE null #-}
null = List.null . Chunky.toChunks
{-# INLINE length #-}
length = sum . List.map (fromIntegral . toInteger) . Chunky.toChunks
intToChunky :: (Ring.C a, NonNeg.C a) => String -> Int -> Chunky.T a
intToChunky name =
Chunky.fromNumber .
-- the non-negative type is not necessarily a wrapper
-- NonNegW.fromNumberMsg ("Generic.Cut."++name) .
fromIntegral .
(\x ->
if x<zero
then error ("Generic.Cut.NonNeg.Chunky."++name++": negative argument")
else x)
instance (ToInteger.C 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 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 mempty)
{-# INLINE reverse #-}
reverse = Chunky.fromChunks . List.reverse . Chunky.toChunks
instance (P.Integral a) => Read (Chunky98.T a) where
{-# INLINE null #-}
null = List.null . Chunky98.toChunks
{-# INLINE length #-}
length = sum . List.map (P.fromIntegral . P.toInteger) . Chunky98.toChunks
intToChunky98 :: (NonNeg98.C a) => String -> Int -> Chunky98.T a
intToChunky98 name =
Chunky98.fromNumber .
-- NonNegW.fromNumberMsg ("Generic.Cut."++name) .
P.fromIntegral .
(\x ->
if x<0
then error ("Generic.Cut.NonNeg.Chunky98."++name++": negative argument")
else x)
instance (P.Integral a, NonNeg98.C a) => Transform (Chunky98.T a) where
{-# INLINE take #-}
take n = P.min (intToChunky98 "take" n)
{-# INLINE drop #-}
drop n x = x NonNeg98.-| intToChunky98 "drop" n
{-# INLINE dropMarginRem #-}
dropMarginRem n m x =
let (z,d,b) =
Chunky98.minMaxDiff
(intToChunky98 "dropMargin/n" n)
(x NonNeg98.-| intToChunky98 "dropMargin/m" m)
in (if b then 0 else P.fromIntegral (Chunky98.toNumber d),
x NonNeg98.-| z)
{-# INLINE splitAt #-}
splitAt n x =
let (z,d,b) = Chunky98.minMaxDiff (intToChunky98 "splitAt" n) x
in (z, if b then d else Chunky98.zero)
{-# INLINE reverse #-}
reverse = Chunky98.fromChunks . List.reverse . Chunky98.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)