{- | 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