synthesizer-inference-0.2: src/Synthesizer/Amplitude/Cut.hs

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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Amplitude.Cut (
   {- * dissection -}
   unzip,
   unzip3,

   {- * glueing -}
   concat,   concatVolume,
   append,   appendVolume,
   zip,      zipVolume,
   zip3,     zip3Volume,
  ) where

import qualified Synthesizer.Amplitude.Signal as SigV
import Synthesizer.Amplitude.Signal (toAmplitudeScalar)

-- import qualified Algebra.NormedSpace.Maximum as NormedMax
import qualified Algebra.OccasionallyScalar  as OccScalar
import qualified Algebra.Module              as Module
import qualified Algebra.Field               as Field
-- import qualified Algebra.Ring                as Ring

import qualified Data.List as List

import PreludeBase (Ord, max, map)
-- import NumericPrelude
import Prelude ()


{- * dissection -}

unzip ::
   SigV.T y y' (yv0, yv1) ->
   (SigV.T y y' yv0, SigV.T y y' yv1)
unzip x =
   let (ss0,ss1) = List.unzip (SigV.samples x)
   in  (SigV.replaceSamples ss0 x, SigV.replaceSamples ss1 x)

unzip3 ::
   SigV.T y y' (yv0, yv1, yv2) ->
   (SigV.T y y' yv0, SigV.T y y' yv1, SigV.T y y' yv2)
unzip3 x =
   let (ss0,ss1,ss2) = List.unzip3 (SigV.samples x)
   in  (SigV.replaceSamples ss0 x, SigV.replaceSamples ss1 x, SigV.replaceSamples ss2 x)



{- * glueing -}

{- |
Similar to @foldr1 append@ but more efficient and accurate,
because it reduces the number of amplifications.
Does not work for infinite lists,
because no maximum amplitude can be computed.
-}
concat ::
   (Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   [SigV.T y y' yv] -> SigV.T y y' yv
concat xs =
   concatVolume (List.maximum (map SigV.amplitude xs)) xs

{- |
Give the output volume explicitly.
Does also work for infinite lists.
-}
concatVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   y' -> [SigV.T y y' yv] -> SigV.T y y' yv
concatVolume amp xs =
   let smps = map (SigV.vectorSamples (toAmplitudeScalar z)) xs
       z = SigV.Cons amp (List.concat smps)
   in  z


merge ::
   (Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1) =>
   ([yv0] -> [yv1] -> [yv2]) ->
   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2
merge f x0 x1 =
   mergeVolume f (max (SigV.amplitude x0) (SigV.amplitude x1)) x0 x1

mergeVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1) =>
   ([yv0] -> [yv1] -> [yv2]) ->
   y' ->
   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2
mergeVolume f amp x y =
   let sampX = SigV.vectorSamples (toAmplitudeScalar z) x
       sampY = SigV.vectorSamples (toAmplitudeScalar z) y
       z = SigV.Cons amp (f sampX sampY)
   in  z


append ::
   (Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   SigV.T y y' yv -> SigV.T y y' yv -> SigV.T y y' yv
append = merge (List.++)

appendVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv) =>
   y' ->
   SigV.T y y' yv -> SigV.T y y' yv -> SigV.T y y' yv
appendVolume = mergeVolume (List.++)


zip ::
   (Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1) =>
   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' (yv0,yv1)
zip = merge List.zip

zipVolume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1) =>
   y' ->
   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' (yv0,yv1)
zipVolume = mergeVolume List.zip



zip3 ::
   (Ord y', Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2 ->
   SigV.T y y' (yv0,yv1,yv2)
zip3 x0 x1 x2 =
   zip3Volume
      (SigV.amplitude x0 `max` SigV.amplitude x1 `max` SigV.amplitude x2)
      x0 x1 x2

zip3Volume ::
   (Field.C y', OccScalar.C y y',
    Module.C y yv0, Module.C y yv1, Module.C y yv2) =>
   y' ->
   SigV.T y y' yv0 -> SigV.T y y' yv1 -> SigV.T y y' yv2 ->
   SigV.T y y' (yv0,yv1,yv2)
zip3Volume amp x0 x1 x2 =
   let sampX0 = SigV.vectorSamples (toAmplitudeScalar z) x0
       sampX1 = SigV.vectorSamples (toAmplitudeScalar z) x1
       sampX2 = SigV.vectorSamples (toAmplitudeScalar z) x2
       z = SigV.Cons amp (List.zip3 sampX0 sampX1 sampX2)
   in  z