packages feed

synthesizer-core 0.7.1 → 0.8

raw patch · 136 files changed

+1491/−1373 lines, 136 filesdep −stream-fusiondep ~non-emptydep ~numeric-preludedep ~process

Dependencies removed: stream-fusion

Dependency ranges changed: non-empty, numeric-prelude, process, transformers, utility-ht

Files

private/Synthesizer/Basic/NumberTheory.hs view
@@ -20,7 +20,7 @@       g(4,2) = 1       g(2^n,2) = 3 for n>=3  ((-1) is always a square root of 1)       g(2^n,2^k) = 2^k for k>=2 && k<n-1-      g(n,2) = 1 for n>=3 and n in OEIS:A033948+      g(n,2) = 1 for n>=3 and n in http://oeis.org/A033948       sum(g(n,k), k\in\N) = phi(n)       There are only a few patterns that occur as rows of g,       but a row of g (i.e. g(n)) does functionally depend on@@ -69,8 +69,66 @@       thus lcm(o1,...,ok) divides the carmichael value of that ring,       thus there is a primitive root of order lcm(o1,...,ok). -}-module Synthesizer.Basic.NumberTheory where+module Synthesizer.Basic.NumberTheory (+   fermatFactors,+   uniquePrimeFactors,+   primeFactors,+   multiplicativeGenerator,+   Order (Order, getOrder),+   PrimitiveRoot(primitiveRootCandidates, maximumOrderOfPrimitiveRootsOfUnity),+   primitiveRootsOfUnity,+   lcmMulti,+   primitiveRootsOfUnityFullOrbit,+   primitiveRootsOfOrbit,+   hasPrimitiveRootOfUnityNaive,+   ordersOfPrimitiveRootsOfUnityTest,+   orderOfOrbit,+   hasPrimitiveRootOfUnityInteger,+   ordersOfPrimitiveRootsOfUnityInteger,+   ordersOfRootsOfUnityInteger,+   ordersOfRootsOfUnityIntegerCondensed,+   rootsOfUnityPower,+   ringsWithPrimitiveRootOfUnityAndUnit,+   ringsWithPrimitiveRootsOfUnityAndUnitsNaive,+   ringWithPrimitiveRootsOfUnityAndUnits,+   ringWithPrimitiveRootsOfUnity,+   is3Smooth,+   is5Smooth,+   numbers3Smooth,+   numbers5Smooth,+   ceilingPowerOfTwo,+   ceilingPower,+   ceilingLog,+   powerOfTwoFactors,+   divideByMaximumPower,+   ceiling3Smooth,+   ceiling5Smooth,+   isPrime,+   raderWorstCases,+   fastFourierRing, +   -- for testing+   multiplicativeGeneratorSet,+   multiplicativeGeneratorDivisors,+   primitiveRootsOfUnityPower,+   primitiveRootsOfUnityNaive,+   primitiveRootsOfUnityFullOrbitTest,+   maximumOrderOfPrimitiveRootsOfUnityNaive,+   maximumOrderOfPrimitiveRootsOfUnityInteger,+   numbers3SmoothCorec,+   numbers3SmoothFoldr,+   numbers3SmoothSet,+   numbers5SmoothCorec,+   numbers5SmoothFoldr,+   numbers5SmoothSet,+   ceiling3SmoothScan,+   ceiling5SmoothScan,+   ceiling3SmoothNaive,+   ceiling5SmoothNaive,+   ceiling3SmoothTrace,+   ceiling5SmoothTrace,+   ) where+ import qualified Synthesizer.State.Signal as SigS  import qualified Data.Set as Set@@ -143,7 +201,7 @@ i.e. 2 or 3.  Smallest multiplicative generators for primes:-http://oeis.org/A001918+<http://oeis.org/A001918>  Especially large generators: $ filter ((>31) . snd) $ map (\n -> (n, multiplicativeGenerator n)) $ tail NumberTheory.primes@@ -437,7 +495,7 @@  {- This is the Carmichael function.-OEIS-A002322+<http://oeis.org/A002322> -} maximumOrderOfPrimitiveRootsOfUnityInteger ::    Integer -> Order@@ -455,7 +513,7 @@  {- The sum of the sub-lists should equal the Euler totient function values-(OEIS-A000010).+<http://oeis.org/A000010>. -} ordersOfPrimitiveRootsOfUnityInteger :: [[Int]] ordersOfPrimitiveRootsOfUnityInteger =@@ -617,7 +675,7 @@  {- | List all numbers that only contain prime factors 2 and 3 in ascending order.-OEIS:A003586+<http://oeis.org/A003586> -} numbers3Smooth :: [Integer] numbers3Smooth = numbers3SmoothCorec@@ -649,7 +707,7 @@  {- Hamming sequence-OEIS:A051037+<http://oeis.org/A051037> -} numbers5Smooth :: [Integer] numbers5Smooth = numbers5SmoothCorec@@ -701,9 +759,9 @@    last $    n : unfoldr (\m -> case divMod m b of (q,r) -> toMaybe (isZero r) (q,q)) n -divideByMaximumPowerRecursive ::+_divideByMaximumPowerRecursive ::    (Integral.C a, Eq a, ZeroTestable.C a) => a -> a -> a-divideByMaximumPowerRecursive b =+_divideByMaximumPowerRecursive b =    let recourse n =           case divMod b n of              (q,0) -> recourse q@@ -796,13 +854,13 @@ We must be careful not to skip combinations that are optimal.  E.g.:-> ceiling5SmoothTraceWrong (10^70+1)+> _ceiling5SmoothTraceWrong (10^70+1) 10002658207445093206727527411583349735126415100956607165326185795158016 > ceiling5Smooth (10^70+1) 10001329015408448808646079907338649600000000000000000000000000000000000 -}-ceiling5SmoothTraceWrong :: Integer -> Integer-ceiling5SmoothTraceWrong n =+_ceiling5SmoothTraceWrong :: Integer -> Integer+_ceiling5SmoothTraceWrong n =    minimum $ map (minimum . ceilingSmoothsTrace 3 5 n) $    ceilingSmoothsTrace 2 3 n $ ceilingPowerOfTwo n @@ -836,8 +894,7 @@ -} partialPrimes :: Integer -> [Integer] partialPrimes =-   let primeFactorSet =-          Set.fromAscList . uniquePrimeFactors+   let primeFactorSet = Set.fromAscList . uniquePrimeFactors    in  unfoldr          (fmap              (\(p,set) ->@@ -910,11 +967,11 @@ Find lengths of signals that require many interim Rader transforms and end with the given length. -raderWorstCases 2  =  OEIS-A061092-raderWorstCases 5  =  tail OEIS-A059411+> raderWorstCases 2  =  <http://oeis.org/A061092>+> raderWorstCases 5  =  tail <http://oeis.org/A059411>  Smallest raderWorstCase numbers are 2,5,13,17,19,31,37,41,43,61,...-This matches the definition of OEIS-A061303.+This matches the definition of <http://oeis.org/A061303>. -} raderWorstCases :: Integer -> [Integer] raderWorstCases =@@ -939,7 +996,7 @@    that is used by Fourier.Element.primitiveRoot    in order to compute a root with maximum order. -2. Reduce the moduli produced by 'fastFourierRingAlt'+2. Reduce the moduli produced by '_fastFourierRingAlt'    by merging some orders that are passed to    ringWithPrimitiveRootsOfUnityAndUnits,    such that an LCM of a group of orders can still be handled.@@ -974,8 +1031,8 @@    that stores the primitive root and its order    additional to the ResidueClass modulus. -}-fastFourierRingAlt :: Int -> Integer-fastFourierRingAlt n =+_fastFourierRingAlt :: Int -> Integer+_fastFourierRingAlt n =    case n of       0 -> 2       1 -> 2
private/Synthesizer/Generic/Permutation.hs view
@@ -3,7 +3,19 @@ Most functions are independent of the Signal framework. We could move them as well to Synthesizer.Basic. -}-module Synthesizer.Generic.Permutation where+module Synthesizer.Generic.Permutation (+   T,+   apply,+   size,+   transposition,+   skewGrid,+   skewGridInv,+   skewGridCRT,+   skewGridCRTInv,+   multiplicative,+   inverse,+   reverse,+   ) where  import qualified Synthesizer.Basic.NumberTheory as NumberTheory @@ -14,6 +26,8 @@ import qualified Data.StorableVector as SV  import qualified Algebra.PrincipalIdealDomain as PID++import Prelude hiding (reverse, )
speedtest/Fourier.hs view
@@ -4,13 +4,11 @@ import qualified Synthesizer.Generic.Fourier as Fourier import qualified Synthesizer.Generic.Noise as NoiseG import qualified Synthesizer.Generic.Signal as SigG--- import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.State.Noise as NoiseS import qualified Synthesizer.State.Signal as SigS  import qualified Data.StorableVector as SV --- import qualified Algebra.Ring as Ring import qualified Number.Complex as NPComplex  import System.TimeIt (timeIt, )
speedtest/SpeedTest.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} module Main (main) where --- import BinarySample (numToInt16)- import System.Time (getClockTime, diffClockTimes, tdSec, tdPicosec) import System.Directory (removeFile)
speedtest/SpeedTestExp.hs view
@@ -41,8 +41,8 @@    fromIntegral (double2Int      (if x<0 then x-0.5 else x+0.5)) -doubleToInt16 :: Double -> Int16-doubleToInt16 x = round (32767 * x)+_doubleToInt16 :: Double -> Int16+_doubleToInt16 x = round (32767 * x)  doubleToInt16' :: Double -> Int16 doubleToInt16' x = round' (32767 * x)
src/Synthesizer/ApplicativeUtility.hs view
@@ -1,11 +1,10 @@ -- this is also used by synthesizer-dimensional and synthesizer-inference module Synthesizer.ApplicativeUtility where -import Control.Applicative (Applicative, (<*>), (<$>), liftA2, )-import Data.Traversable (Traversable, sequenceA, )- import Control.Arrow (Arrow, (<<<), ) import Control.Monad.Fix (fix, )+import Control.Applicative (Applicative, (<*>), (<$>), liftA2, )+import Data.Traversable (Traversable, sequenceA, )   {-# INLINE liftA4 #-}
src/Synthesizer/Basic/Binary.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Basic.Binary-   (C(..), toCanonical,-    fromCanonicalWith, fromCanonicalSimpleWith,-    numberOfSignalChannels,-    int16ToCanonical, int16FromCanonical,-    int16FromFloat, int16FromDouble,-    ) where+module Synthesizer.Basic.Binary (+   C(..), toCanonical,+   fromCanonicalWith, fromCanonicalSimpleWith,+   numberOfSignalChannels,+   int16ToCanonical, int16FromCanonical,+   int16FromFloat, int16FromDouble,+   ) where  import qualified Synthesizer.Frame.Stereo as Stereo @@ -24,11 +24,9 @@ import Data.Int (Int16, ) import GHC.Float (float2Int, double2Int, ) -import qualified Prelude as P98--import NumericPrelude.Base import NumericPrelude.Numeric-+import NumericPrelude.Base+import qualified Prelude as P98
src/Synthesizer/Basic/ComplexModule.hs view
@@ -8,7 +8,6 @@ import Number.Complex ((+:), )  import NumericPrelude.Numeric--- import NumericPrelude.Base import Prelude ()
src/Synthesizer/Basic/Distortion.hs view
@@ -19,14 +19,11 @@ import qualified Algebra.RealRing              as RealRing import qualified Algebra.Ring                  as Ring -import Data.Ord.HT (limit, )- import Data.List.HT (mapAdjacent, )--- import Data.List ((!!), map, iterate, take, foldl, )+import Data.Ord.HT (limit, ) --- import qualified Prelude as P-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Clipping -}
src/Synthesizer/Basic/DistortionControlled.hs view
@@ -14,9 +14,8 @@  import Data.Ord.HT (limit, ) --- import qualified Prelude as P--- import NumericPrelude.Base import NumericPrelude.Numeric+  {- * Clipping -}
+ src/Synthesizer/Basic/Filter/NonRecursive.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Synthesizer.Basic.Filter.NonRecursive where++import qualified Data.List.Match as Match+import Data.Tuple.HT (sortPair, )++import qualified Algebra.Transcendental as Trans+import qualified Algebra.Additive       as Additive++import NumericPrelude.Numeric+import NumericPrelude.Base+++unitSizesFromPyramid :: [signal] -> [Int]+unitSizesFromPyramid pyr =+   reverse $ Match.take pyr $ iterate (2*) 1++sumRangePrepare :: (Additive.C v) =>+   ((Int,Int) -> source -> v) ->+   (source -> (Int,Int) -> v)+sumRangePrepare f pyr (l,r) =+   case compare l r of+      LT -> f (l,r) pyr+      GT -> negate $ f (r,l) pyr+      EQ -> zero++symmetricRangePrepare ::+   ((Int,Int) -> source -> v) ->+   (source -> (Int,Int) -> v)+symmetricRangePrepare f pyr lr = f (sortPair lr) pyr++{-+exp (-(t/var)^2/2) / area *> cis (2*pi*f*t)+  == exp (-(t/var)^2/2 +: 2*pi*f*t) / area+  == exp ((-t^2 +: 2*var^2*2*pi*f*t) / (2*var^2)) / area+  == exp ((t^2 - i*2*var^2*2*pi*f*t) / (-2*var^2)) / area+  == exp (((t^2 - i*var^2*2*pi*f)^2 + (var^2*2*pi*f)^2) / (-2*var^2)) / area+  == exp (((t^2 - i*var^2*2*pi*f)^2 / (-2*var^2) - (var*2*pi*f)^2/2)) / area++sumMap (\t -> exp (-(t/var)^2/2) / area *> cis (2*pi*f*t))+       [-infinity..infinity]+  ~ sumMap (\t -> exp (-(t/var)^2/2)) [-infinity..infinity]+       * exp (-(var*2*pi*f)^2/2) / area+  = exp (-(var*2*pi*f)^2/2)+-}+{- |+  Compute the variance of the Gaussian+  such that its Fourier transform has value @ratio@ at frequency @freq@.+-}+ratioFreqToVariance :: (Trans.C a) => a -> a -> a+ratioFreqToVariance ratio freq =+   sqrt (-2 * log ratio) / (2*pi*freq)+           -- inverse of the fourier transformed gaussian
src/Synthesizer/Basic/Phase.hs view
@@ -1,25 +1,23 @@-module Synthesizer.Basic.Phase-   (T,-    fromRepresentative,-    toRepresentative,-    increment,-    decrement,-    multiply,+module Synthesizer.Basic.Phase (+   T,+   fromRepresentative,+   toRepresentative,+   increment,+   decrement,+   multiply,    ) where +import qualified Algebra.ToInteger             as ToInteger import qualified Algebra.RealRing              as RealRing import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import qualified Algebra.ToInteger             as ToInteger- import System.Random (Random(..)) import Test.QuickCheck (Arbitrary(arbitrary), choose)  import Foreign.Storable (Storable(..), ) import Foreign.Ptr (castPtr, ) --- import Data.Function.HT (powerAssociative, ) import Data.Tuple.HT (mapFst, )  import qualified NumericPrelude.Numeric as NP
src/Synthesizer/Basic/ToneModulation.hs view
@@ -1,5 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Basic.ToneModulation where+module Synthesizer.Basic.ToneModulation (+   untangleShapePhase, untangleShapePhaseAnalytic,+   flattenShapePhase, flattenShapePhaseAnalytic,+   shapeLimits,+   interpolationOffset, interpolationNumber,+   Coords, Skip,+   ) where  import qualified Synthesizer.Basic.Phase as Phase
src/Synthesizer/Basic/Wave.hs view
@@ -14,8 +14,69 @@ If you want to use parametrized waves with two parameters then zip your parameter signals and apply 'uncurry' to the wave function. -}-module Synthesizer.Basic.Wave where+module Synthesizer.Basic.Wave (+   T(Cons, decons),+   fromFunction,+   raise,+   amplify,+   distort,+   overtone,+   apply,+   phaseOffset, +   sine,+   cosine,+   helix,+   fastSine2,+   fastSine2Alt,+   fastSine3,+   fastSine3Alt,+   fastSine4,+   fastSine4Alt,+   fastSine4LeastSquares,+   fastSinePolynomials,+   fastSines,+   rationalHelix1,+   rationalHelix1Alt,+   rationalHelix,+   saw,+   sawCos,+   sawComplex,+   square,+   squareCos,+   squareComplex,+   triangle,+   truncOddCosine,+   truncOddTriangle,+   truncCosine,+   truncTriangle,+   powerNormed,+   logitSaw,+   logitSine,+   sineSquare,+   piecewiseParabolaSaw,+   piecewiseSineSaw,+   sineSawSmooth,+   sineSawSharp,+   sawGaussianHarmonics,+   sawPike,+   trianglePike,+   trianglePikeShift,+   squarePike,+   squarePikeShift,+   squareAsymmetric,+   squareBalanced,+   triangleAsymmetric,+   trapezoid,+   trapezoidAsymmetric,+   trapezoidBalanced,+   trapezoidSkew,++   Harmonic(Harmonic, harmonicPhase, harmonicAmplitude),+   harmonic,+   composedHarmonics,+   ) where+ import qualified Synthesizer.Basic.Phase as Phase  import qualified Algebra.RealTranscendental    as RealTrans@@ -39,7 +100,6 @@ import Data.Bool.HT (select, if', ) import NumericPrelude.Numeric --- import qualified Prelude as P import NumericPrelude.Base  @@ -107,7 +167,7 @@ {- | Turn an unparametrized waveform into a parametrized one, where the parameter is a phase offset.-This way you express a phase modulated oscillator+This way you may express a phase modulated oscillator using a shape modulated oscillator.  @flip phaseOffset@ could have also be named @rotateLeft@,@@ -232,9 +292,9 @@  {- | The coefficient of the highest power is the reciprocal of an element from-http://www.research.att.com/~njas/sequences/A000111+<http://oeis.org/A000111> and the polynomial coefficients are-http://www.research.att.com/~njas/sequences/A119879 .+<http://oeis.org/A119879> .  > mapM_ print $ map (\p -> fmap ((round :: Rational -> Integer) . (/last(Poly.coeffs p))) p) (take 10 $ fastSinePolynomials) -}@@ -274,7 +334,7 @@  {- | This is a helix that is distorted in phase-such that is a purely rational function.+such that it becomes a purely rational function. It is guaranteed that the magnitude of the wave is one. For the distortion factor @recip pi@ you get the closest approximation to an undistorted helix.
src/Synthesizer/Basic/WaveSmoothed.hs view
@@ -38,12 +38,10 @@ import qualified Synthesizer.Basic.Wave  as Wave import qualified Synthesizer.Basic.Phase as Phase --- import qualified Algebra.RealTranscendental    as RealTrans import qualified Algebra.Transcendental        as Trans--- import qualified Algebra.RealField             as RealField import qualified Algebra.Module                as Module import qualified Algebra.Field                 as Field-import qualified Algebra.RealRing                  as RealRing+import qualified Algebra.RealRing              as RealRing import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive @@ -51,8 +49,6 @@ import qualified Number.Complex     as Complex  import NumericPrelude.Numeric---- import qualified Prelude as P import NumericPrelude.Base
src/Synthesizer/Causal/Analysis.hs view
@@ -12,10 +12,13 @@  import qualified Data.Map as Map --- import qualified Prelude as P-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base ++flipFlopHysteresis ::+   (Ord y) => (y,y) -> Ana.BinaryLevel -> Causal.T y Ana.BinaryLevel+flipFlopHysteresis bnds = Causal.scanL (Ana.flipFlopHysteresisStep bnds)  deltaSigmaModulation ::    RealRing.C y => Causal.T y Ana.BinaryLevel
src/Synthesizer/Causal/Class.hs view
@@ -11,9 +11,10 @@ import Control.Arrow (Arrow, arr, (<<<), (&&&), )  +type family ProcessOf (signal :: * -> *) :: * -> * -> *+ class (Arrow process, ProcessOf (SignalOf process) ~ process) => C process where    type SignalOf process :: * -> *-   type ProcessOf (signal :: * -> *) :: * -> * -> *    toSignal :: process () a -> SignalOf process a    fromSignal :: SignalOf process b -> process a b
src/Synthesizer/Causal/Cut.hs view
@@ -3,13 +3,12 @@  import qualified Synthesizer.Causal.Process as Causal -import Data.Maybe.HT (toMaybe, )- import Control.Monad.Trans.State (StateT(StateT), ) --- import qualified Prelude as P-import NumericPrelude.Base+import Data.Maybe.HT (toMaybe, )+ import NumericPrelude.Numeric+import NumericPrelude.Base   {-# INLINE take #-}
src/Synthesizer/Causal/Displacement.hs view
@@ -7,8 +7,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   -- * Mixing
src/Synthesizer/Causal/Filter/NonRecursive.hs view
@@ -6,7 +6,7 @@  import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG import qualified Synthesizer.Generic.Signal as SigG-import qualified Synthesizer.Plain.Filter.NonRecursive as Filt+import qualified Synthesizer.Basic.Filter.NonRecursive as Filt import qualified Synthesizer.State.Control as CtrlS import qualified Synthesizer.State.Signal as SigS import Synthesizer.Utility (affineComb, )@@ -16,9 +16,8 @@ import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -import NumericPrelude.Base-import NumericPrelude.Numeric as NP--- import qualified Prelude as P+import NumericPrelude.Numeric+import NumericPrelude.Base as NP   {-# INLINE amplify #-}
src/Synthesizer/Causal/Filter/Recursive/Integration.hs view
@@ -14,12 +14,10 @@ import qualified Synthesizer.Causal.Process as Causal import qualified Control.Monad.Trans.State as State --- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Causal/Interpolation.hs view
@@ -25,8 +25,8 @@ import qualified Algebra.Additive  as Additive  -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-* Interpolation at multiple nodes with various padding methods -}
src/Synthesizer/Causal/Oscillator.hs view
@@ -12,19 +12,17 @@ module Synthesizer.Causal.Oscillator where  import qualified Synthesizer.Causal.Oscillator.Core as Osci+import qualified Synthesizer.Causal.Process as Causal+import qualified Synthesizer.Causal.Interpolation as InterpolationC+import qualified Synthesizer.Causal.ToneModulation as ToneMod  import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth import qualified Synthesizer.Basic.Wave         as Wave import qualified Synthesizer.Basic.Phase        as Phase -import qualified Synthesizer.Causal.Process as Causal-import qualified Synthesizer.State.Signal as Sig--import qualified Synthesizer.Causal.Interpolation as InterpolationC-import qualified Synthesizer.Causal.ToneModulation as ToneMod import qualified Synthesizer.Interpolation as Interpolation- import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.State.Signal as Sig  import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField
src/Synthesizer/Causal/Oscillator/Core.hs view
@@ -20,9 +20,9 @@ import qualified Synthesizer.Causal.Process as Causal import qualified Synthesizer.State.Signal as Sig -import qualified Algebra.RealRing             as RealRing- import Control.Arrow ((^<<), (&&&), second, returnA, )++import qualified Algebra.RealRing             as RealRing  import NumericPrelude.Numeric import NumericPrelude.Base
src/Synthesizer/Causal/Process.hs view
@@ -70,7 +70,7 @@    -- for testing    applyFst',    applySnd',-) where+   ) where  import qualified Synthesizer.State.Signal as Sig import qualified Synthesizer.Generic.Signal as SigG@@ -175,9 +175,10 @@    loop = liftKleisli loop  +type instance Class.ProcessOf Sig.T = T+ instance Class.C T where    type SignalOf T = Sig.T-   type ProcessOf Sig.T = T    toSignal = flip applyConst ()    fromSignal sig = const () ^>> feed sig
src/Synthesizer/Causal/Spatial.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE NoImplicitPrelude #-} module Synthesizer.Causal.Spatial where +import Control.Arrow (Arrow, arr, )+ import qualified Algebra.NormedSpace.Euclidean as Euc import qualified Algebra.Field                 as Field -import Control.Arrow (Arrow, arr, )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-|
src/Synthesizer/Causal/ToneModulation.hs view
@@ -11,10 +11,16 @@    ) where  import qualified Synthesizer.Basic.ToneModulation as ToneMod+import qualified Synthesizer.Basic.Phase as Phase import qualified Synthesizer.State.ToneModulation as ToneModS import qualified Synthesizer.Interpolation as Interpolation import qualified Synthesizer.Causal.Oscillator.Core as Osci+import qualified Synthesizer.Causal.Process as Causal+import qualified Synthesizer.Generic.Signal as SigG +import Control.Arrow (first, (<<<), (<<^), (^<<), (&&&), (***), )+import Control.Monad.Trans.State (state, )+ {- for testing in GHCi import qualified Synthesizer.Plain.ToneModulation as ToneModL import qualified Synthesizer.State.Signal as SigS@@ -22,24 +28,11 @@ -} import Data.Tuple.HT (mapFst, ) -import qualified Synthesizer.Causal.Process as Causal--import qualified Synthesizer.Generic.Signal as SigG--import qualified Synthesizer.Basic.Phase as Phase---- import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField--- import qualified Algebra.Field                 as Field--- import qualified Algebra.RealRing                  as RealRing import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import Control.Arrow (first, (<<<), (<<^), (^<<), (&&&), (***), )-import Control.Monad.Trans.State (state, )- import NumericPrelude.Numeric--- import qualified Prelude as P import NumericPrelude.Base import Prelude ()
src/Synthesizer/CausalIO/Gate.hs view
@@ -10,18 +10,17 @@ import qualified Synthesizer.CausalIO.Process as PIO import qualified Synthesizer.Zip as Zip -import Synthesizer.PiecewiseConstant.Signal (StrictTime, ) import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.Generic.Signal as SigG--import qualified Data.StorableVector as SV+import Synthesizer.PiecewiseConstant.Signal (StrictTime, )  import qualified Control.Monad.Trans.State as MS- import Control.Arrow (Arrow, arr, (^<<), ) import Control.Monad (when, )-import Data.Maybe.HT (toMaybe, )++import qualified Data.StorableVector as SV import qualified Data.Monoid as Mn+import Data.Maybe.HT (toMaybe, )  import qualified Numeric.NonNegative.Class as NonNeg import qualified Numeric.NonNegative.Wrapper as NonNegW
src/Synthesizer/CausalIO/Process.hs view
@@ -34,10 +34,8 @@ import Foreign.Storable (Storable, )  import qualified Control.Monad.Trans.State as MS- import qualified Control.Arrow    as Arr import qualified Control.Category as Cat- import Control.Arrow ((^<<), (&&&), ) import Control.Monad (mplus, )
src/Synthesizer/ChunkySize/Cut.hs view
@@ -5,28 +5,24 @@ module Synthesizer.ChunkySize.Cut where  import qualified Synthesizer.ChunkySize as ChunkySize- import qualified Synthesizer.Generic.Cut as Cut import qualified Synthesizer.Generic.Signal as SigG- import qualified Synthesizer.State.Signal as SigS+ import qualified Data.StorableVector.Lazy.Pattern as SigStV import qualified Data.StorableVector.Lazy as Vector-+import Foreign.Storable (Storable)  import qualified Number.NonNegativeChunky as Chunky -import Foreign.Storable (Storable)--import qualified Data.List as List import qualified Data.List.Match as Match+import qualified Data.List as List import Data.Tuple.HT (mapPair, )- import Data.Monoid (Monoid, ) -import Prelude () import NumericPrelude.Numeric import NumericPrelude.Base hiding (splitAt, Read, )+import Prelude ()   class Cut.Read sig => Read sig where
src/Synthesizer/ChunkySize/Signal.hs view
@@ -5,26 +5,20 @@ import qualified Synthesizer.ChunkySize.Cut as Cut import qualified Synthesizer.ChunkySize as ChunkySize --- import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.Generic.Signal as SigG --- import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.State.Signal as SigS--- import qualified Synthesizer.Storable.Signal as SigSt+ import qualified Data.StorableVector.Lazy.Pattern as SigStV import qualified Data.StorableVector.Lazy as Vector- import Foreign.Storable (Storable) -import qualified Data.List.Match as Match- import Control.Monad.Trans.State (runStateT, ) +import qualified Data.List.Match as Match import qualified Data.List as List --- import NumericPrelude.Numeric-import Prelude-   (Maybe(Just), fst, (.), id, )+import Prelude (Maybe(Just), fst, (.), id, )   class (SigG.Write sig y, Cut.Transform (sig y)) => Write sig y where
src/Synthesizer/Generic/Analysis.hs view
@@ -3,7 +3,8 @@ {-# LANGUAGE FlexibleContexts #-} module Synthesizer.Generic.Analysis where -import qualified Synthesizer.State.Analysis as Ana+import qualified Synthesizer.Plain.Analysis as Ana+import qualified Synthesizer.State.Analysis as AnaS  import qualified Synthesizer.Generic.Signal as SigG @@ -16,8 +17,8 @@ import qualified Algebra.NormedSpace.Euclidean as NormedEuc import qualified Algebra.NormedSpace.Sum       as NormedSum -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Notions of volume -}@@ -27,25 +28,25 @@ -} volumeMaximum :: (RealRing.C y, SigG.Read sig y) => sig y -> y volumeMaximum =-   Ana.volumeMaximum . SigG.toState+   AnaS.volumeMaximum . SigG.toState  {- | Volume based on Energy norm. -} volumeEuclidean :: (Algebraic.C y, SigG.Read sig y) => sig y -> y volumeEuclidean =-   Ana.volumeEuclidean . SigG.toState+   AnaS.volumeEuclidean . SigG.toState  volumeEuclideanSqr :: (Field.C y, SigG.Read sig y) => sig y -> y volumeEuclideanSqr =-   Ana.volumeEuclideanSqr . SigG.toState+   AnaS.volumeEuclideanSqr . SigG.toState  {- | Volume based on Sum norm. -} volumeSum :: (Field.C y, RealRing.C y, SigG.Read sig y) => sig y -> y volumeSum =-   Ana.volumeSum . SigG.toState+   AnaS.volumeSum . SigG.toState   @@ -56,7 +57,7 @@    (NormedMax.C y yv, Ord y, SigG.Read sig yv) =>    sig yv -> y volumeVectorMaximum =-   Ana.volumeVectorMaximum . SigG.toState+   AnaS.volumeVectorMaximum . SigG.toState  {- | Volume based on Energy norm.@@ -65,13 +66,13 @@    (Algebraic.C y, NormedEuc.C y yv, SigG.Read sig yv) =>    sig yv -> y volumeVectorEuclidean =-   Ana.volumeVectorEuclidean . SigG.toState+   AnaS.volumeVectorEuclidean . SigG.toState  volumeVectorEuclideanSqr ::    (Field.C y, NormedEuc.Sqr y yv, SigG.Read sig yv) =>    sig yv -> y volumeVectorEuclideanSqr =-   Ana.volumeVectorEuclideanSqr . SigG.toState+   AnaS.volumeVectorEuclideanSqr . SigG.toState  {- | Volume based on Sum norm.@@ -80,7 +81,7 @@    (NormedSum.C y yv, Field.C y, SigG.Read sig yv) =>    sig yv -> y volumeVectorSum =-   Ana.volumeVectorSum . SigG.toState+   AnaS.volumeVectorSum . SigG.toState   @@ -91,7 +92,7 @@ -} bounds :: (Ord y, SigG.Read sig y) => sig y -> (y,y) bounds =-   Ana.bounds . SigG.toState+   AnaS.bounds . SigG.toState   @@ -221,8 +222,8 @@  spread ::    (RealField.C y, SigG.Read sig y) => (y,y) -> [(Int,y)]-spread (l0,r0) =-   let (l,r) = if l0<=r0 then (l0,r0) else (r0,l0)+spread lr0 =+   let (l,r) = sortPair lr0        (li,lf) = splitFraction l        (ri,rf) = splitFraction r        k = recip (r-l)@@ -248,18 +249,18 @@ scalarProduct ::    (Ring.C y, SigG.Read sig y) => sig y -> sig y -> y scalarProduct xs ys =-   Ana.scalarProduct (SigG.toState xs) (SigG.toState ys)+   AnaS.scalarProduct (SigG.toState xs) (SigG.toState ys)  {- | 'directCurrentOffset' must be non-zero. -} centroid :: (Field.C y, SigG.Read sig y) => sig y -> y centroid =-   Ana.centroid . SigG.toState+   AnaS.centroid . SigG.toState  average :: (Field.C y, SigG.Read sig y) => sig y -> y average =-   Ana.average . SigG.toState+   AnaS.average . SigG.toState  rectify :: (RealRing.C y, SigG.Transform sig y) => sig y -> sig y rectify = SigG.map abs@@ -284,14 +285,10 @@ {- | Detect thresholds with a hysteresis. -}-flipFlopHysteresis :: (Ord y, SigG.Transform sig y, SigG.Transform sig Bool) =>-   (y,y) -> Bool -> sig y -> sig Bool-flipFlopHysteresis (lower,upper) =-   SigG.scanL-      (\state x ->-          if state-            then not(x<lower)-            else x>upper)+flipFlopHysteresis ::+   (Ord y, SigG.Transform sig y, SigG.Transform sig Ana.BinaryLevel) =>+   (y,y) -> Ana.BinaryLevel -> sig y -> sig Ana.BinaryLevel+flipFlopHysteresis bnds = SigG.scanL (Ana.flipFlopHysteresisStep bnds)  {- | Almost naive implementation of the chirp transform,@@ -304,5 +301,5 @@    SigG.LazySize -> y -> sig y -> sig y chirpTransform size z =    SigG.fromState size .-   Ana.chirpTransform z .+   AnaS.chirpTransform z .    SigG.toState
src/Synthesizer/Generic/Control.hs view
@@ -1,23 +1,38 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-}-module Synthesizer.Generic.Control where+module Synthesizer.Generic.Control (+   constant,+   linear,+   linearMultiscale,+   linearMultiscaleNeutral,+   line,+   exponential, exponentialMultiscale,+   exponentialMultiscaleNeutral,+   exponential2, exponential2Multiscale,+   exponential2MultiscaleNeutral,+   vectorExponential,+   vectorExponential2,+   cosine, cosineMultiscaleLinear,+   cosineMultiscale,+   Ctrl.cosineWithSlope,+   cubicHermite,+   ) where -import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.Plain.Control as Ctrl -import Synthesizer.Generic.Displacement (raise)+import qualified Synthesizer.Generic.Signal as SigG  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.Additive              as Additive -import Number.Complex (cis,real) import qualified Number.Complex as Complex+import Number.Complex (cis,real) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Control curve generation -}@@ -148,10 +163,10 @@    ->  y  {-^ time t1 where -1 is approached -}    -> sig y           {-^ a cosine wave where one half wave is between t0 and t1 -}-cosine size = cosineWithSlope $+cosine size = Ctrl.cosineWithSlope $    \d x -> SigG.map cos (linear size d x) -cosineMultiscaleLinear size = cosineWithSlope $+cosineMultiscaleLinear size = Ctrl.cosineWithSlope $    \d x -> SigG.map cos (linearMultiscale size d x)  cosineMultiscale ::@@ -162,173 +177,15 @@    ->  y  {-^ time t1 where -1 is approached -}    -> sig y           {-^ a cosine wave where one half wave is between t0 and t1 -}-cosineMultiscale size = cosineWithSlope $+cosineMultiscale size = Ctrl.cosineWithSlope $    \d x -> SigG.map real (curveMultiscale size (*) (cis d) (cis x))  -cosineWithSlope :: (Trans.C y) =>-      (y -> y -> signal)-   ->  y-   ->  y-   -> signal-cosineWithSlope c t0 t1 =-   let inc = pi/(t1-t0)-   in  c inc (-t0*inc)-- cubicHermite :: (Field.C y, SigG.Write sig y) =>       SigG.LazySize    -> (y, (y,y)) -> (y, (y,y)) -> sig y cubicHermite size node0 node1 =-   SigG.map (cubicFunc node0 node1) $ linear size 1 0--{- |-0                                     16-0               8                     16-0       4       8         12          16-0   2   4   6   8   10    12    14    16-0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16--}-cubicFunc :: (Field.C y) =>-   (y, (y,y)) -> (y, (y,y)) -> y -> y-cubicFunc (t0, (y0,dy0)) (t1, (y1,dy1)) t =-   let dt  = t0-t1-       dt0 = t-t0-       dt1 = t-t1-       x0  = dt1^2-       x1  = dt0^2-   in  ((dy0*dt0 + y0 * (1-2/dt*dt0)) * x0 +-        (dy1*dt1 + y1 * (1+2/dt*dt1)) * x1) / dt^2-{--cubic t0 (y0,dy0) t1 (y1,dy1) t =-   let x0 = ((t-t1) / (t0-t1))^2-       x1 = ((t-t0) / (t1-t0))^2-   in  y0 * x0 + y1 * x1 +-       (dy0 - y0*2/(t0-t1)) * (t-t0)*x0 +-       (dy1 - y1*2/(t1-t0)) * (t-t1)*x1--}----{-# DEPRECATED Control "use Synthesizer.Generic.Piece instead" #-}-{- |-The curve type of a piece of a piecewise defined control curve.--}-data Control y =-     CtrlStep-   | CtrlLin-   | CtrlExp {ctrlExpSaturation :: y}-   | CtrlCos-   | CtrlCubic {ctrlCubicGradient0 :: y,-                ctrlCubicGradient1 :: y}-   deriving (Eq, Show)--{- |-The full description of a control curve piece.--}-data ControlPiece y =-     ControlPiece {pieceType :: Control y,-                   pieceY0 :: y,-                   pieceY1 :: y,-                   pieceDur :: y}-   deriving (Eq, Show)---newtype PieceRightSingle y = PRS y-newtype PieceRightDouble y = PRD y--type ControlDist y = (y, Control y, y)----- precedence and associativity like (:)-infixr 5 -|#, #|-, =|#, #|=, |#, #|--{- |-The 6 operators simplify constructing a list of @ControlPiece a@.-The description consists of nodes (namely the curve values at nodes)-and the connecting curve types.-The naming scheme is as follows:-In the middle there is a bar @|@.-With respect to the bar,-the pad symbol @\#@ is at the side of the curve type,-at the other side there is nothing, a minus sign @-@, or an equality sign @=@.-- (1) Nothing means that here is the start or the end node of a curve.-- (2) Minus means that here is a node where left and right curve meet at the same value.-     The node description is thus one value.-- (3) Equality sign means that here is a split node,-     where left and right curve might have different ending and beginning values, respectively.-     The node description consists of a pair of values.--}---- the leading space is necessary for the Haddock parser--( #|-) :: (y, Control y) -> (PieceRightSingle y, [ControlPiece y]) ->-   (ControlDist y, [ControlPiece y])-(d,c) #|- (PRS y1, xs)  =  ((d,c,y1), xs)--(-|#) :: y -> (ControlDist y, [ControlPiece y]) ->-   (PieceRightSingle y, [ControlPiece y])-y0 -|# ((d,c,y1), xs)  =  (PRS y0, ControlPiece c y0 y1 d : xs)--( #|=) :: (y, Control y) -> (PieceRightDouble y, [ControlPiece y]) ->-   (ControlDist y, [ControlPiece y])-(d,c) #|= (PRD y1, xs)  =  ((d,c,y1), xs)--(=|#) :: (y,y) -> (ControlDist y, [ControlPiece y]) ->-   (PieceRightDouble y, [ControlPiece y])-(y01,y10) =|# ((d,c,y11), xs)  =  (PRD y01, ControlPiece c y10 y11 d : xs)--( #|) :: (y, Control y) -> y ->-   (ControlDist y, [ControlPiece y])-(d,c) #| y1  =  ((d,c,y1), [])--(|#) :: y -> (ControlDist y, [ControlPiece y]) ->-   [ControlPiece y]-y0 |# ((d,c,y1), xs)  =  ControlPiece c y0 y1 d : xs---piecewise :: (Trans.C y, RealRing.C y, SigG.Write sig y) =>-   SigG.LazySize -> [ControlPiece y] -> sig y-piecewise size xs =-   let ts = scanl (\(_,fr) d -> splitFraction (fr+d))-                  (0,1) (map pieceDur xs)-   in  SigG.concat (zipWith3-          (\n t (ControlPiece c yi0 yi1 d) ->-               piecewisePart size yi0 yi1 t d n c)-          (map fst (tail ts)) (map (subtract 1 . snd) ts)-          xs)---piecewisePart :: (Trans.C y, SigG.Write sig y) =>-   SigG.LazySize -> y -> y -> y -> y -> Int -> Control y -> sig y-piecewisePart size y0 y1 t0 d n ctrl =-   SigG.take n-      (case ctrl of-         CtrlStep  -> constant size y0-         CtrlLin   -> let s = (y1-y0)/d in linearMultiscale size s (y0-t0*s)-         CtrlExp s -> let y0' = y0-s; y1' = y1-s; yd = y0'/y1'-                      in  raise s (exponentialMultiscale size (d / log yd)-                                           (y0' * yd**(t0/d)))-         CtrlCos   -> SigG.map-                          (\y -> (1+y)*(y0/2)+(1-y)*(y1/2))-                          (cosineMultiscaleLinear size t0 (t0+d))-         CtrlCubic yd0 yd1 ->-            cubicHermite size (t0,(y0,yd0)) (t0+d,(y1,yd1)))--{--  exp (-1/time) == yd**(-1/d)-  1/time == log yd / d-  time   == d / log yd--}--{--  piecewise (0 |# (10.21, CtrlExp 1.1) #|- 1 -|# (10,CtrlExp 0.49) #|- 0.5 -|# (30, CtrlLin) #|- 0.5 -|# (20, CtrlCos) #| 0)--  piecewise (0 |# (10.21, CtrlExp 1.1) #|- 1 -|# (10,CtrlCubic (-0.1) 0) #|- 0.5 -|# (30, CtrlLin) #|- 0.5 -|# (20, CtrlCos) #| 0)--}+   SigG.map (Ctrl.cubicFunc node0 node1) $ linear size 1 0   {- * Auxiliary functions -}
src/Synthesizer/Generic/Cut.hs view
@@ -9,7 +9,6 @@  import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.State.Signal as SigS--- import qualified Synthesizer.Storable.Signal as SigSt import qualified Data.StorableVector as SV import qualified Data.StorableVector.Lazy as SVL @@ -30,11 +29,10 @@ import Control.DeepSeq (NFData, rnf, )  import qualified Data.List.HT as ListHT-import qualified Data.List.Stream as List+import qualified Data.List as List+import qualified Data.Monoid as Monoid import Data.Function (fix, ) import Data.Tuple.HT (mapPair, mapFst, mapSnd, )--import qualified Data.Monoid as Monoid import Data.Monoid (Monoid, mempty, )  import qualified Prelude as P
src/Synthesizer/Generic/CutChunky.hs view
@@ -10,8 +10,8 @@  import qualified Number.NonNegativeChunky as Chunky import qualified Algebra.NonNegative as NonNeg- import qualified Algebra.ToInteger as ToInteger+   class (Cut.Transform chunky, Cut.Transform (Chunk chunky)) => C chunky where
src/Synthesizer/Generic/Displacement.hs view
@@ -10,9 +10,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive --- import qualified Prelude as P-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   -- * Mixing
src/Synthesizer/Generic/Filter/Delay.hs view
@@ -1,5 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Generic.Filter.Delay where+module Synthesizer.Generic.Filter.Delay (+   static,+   staticPad,+   staticPos,+   staticNeg,+   modulated,+   ) where  import qualified Synthesizer.Generic.Filter.NonRecursive as FiltNR import qualified Synthesizer.Generic.Interpolation as Interpolation@@ -8,8 +14,6 @@ import qualified Algebra.RealField as RealField import qualified Algebra.Additive  as Additive --- import qualified Prelude as P--- import NumericPrelude.Base import NumericPrelude.Numeric
src/Synthesizer/Generic/Filter/NonRecursive.hs view
@@ -8,17 +8,85 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.Generic.Filter.NonRecursive where+module Synthesizer.Generic.Filter.NonRecursive (+   negate,+   amplify,+   amplifyVector,+   normalize,+   envelope,+   envelopeVector,+   fadeInOut,+   delay,+   delayPad,+   delayPos,+   delayNeg,+   delayLazySize,+   delayPadLazySize,+   delayPosLazySize,+   binomialMask,+   binomial,+   binomial1,+   sums,+   sumsDownsample2,+   downsample2,+   downsample,+   sumRange,+   pyramid,+   sumRangeFromPyramid,+   sumsPosModulated,+   sumsPosModulatedPyramid,+   movingAverageModulatedPyramid,+   inverseFrequencyModulationFloor, +   differentiate,+   differentiateCenter,+   differentiate2,++   generic,+   karatsubaFinite,+   karatsubaFiniteInfinite,+   karatsubaInfinite,++   Pair,+   convolvePair,+   sumAndConvolvePair,+   Triple,+   convolvePairTriple,+   convolveTriple,+   sumAndConvolveTriple,+   sumAndConvolveTripleAlt,+   Quadruple,+   convolveQuadruple,+   sumAndConvolveQuadruple,+   sumAndConvolveQuadrupleAlt,++   -- for use in Storable.Filter.NonRecursive+   maybeAccumulateRangeFromPyramid,+   accumulatePosModulatedFromPyramid,+   withPaddedInput,+   -- for use in Generic.Fourier+   addShiftedSimple,++   -- for testing+   consumeRangeFromPyramid,+   sumRangeFromPyramidReverse,+   sumRangeFromPyramidFoldr,+   ) where+ import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.Generic.Control as Ctrl import qualified Synthesizer.Generic.LengthSignal as SigL -import qualified Synthesizer.State.Signal as SigS-import qualified Synthesizer.Plain.Filter.NonRecursive as Filt+import qualified Synthesizer.Basic.Filter.NonRecursive as Filt import qualified Synthesizer.State.Filter.NonRecursive as FiltS+import qualified Synthesizer.State.Signal as SigS +import Control.Monad (mplus, )+import Data.Function.HT (nest, )+import Data.Tuple.HT (mapSnd, mapPair, )+import Data.Maybe.HT (toMaybe, )+ import qualified Algebra.Transcendental as Trans import qualified Algebra.Module         as Module import qualified Algebra.RealField      as RealField@@ -26,13 +94,9 @@ import qualified Algebra.Ring           as Ring import qualified Algebra.Additive       as Additive -import Control.Monad (mplus, )-import Data.Function.HT (nest, )-import Data.Tuple.HT (mapSnd, mapPair, )-import Data.Maybe.HT (toMaybe, )-+import qualified NumericPrelude.Numeric as NP+import NumericPrelude.Numeric hiding (negate, ) import NumericPrelude.Base-import NumericPrelude.Numeric as NP   -- * Envelope application@@ -186,7 +250,7 @@    (Trans.C a, RealField.C a, Module.C a v) =>    a -> a -> a -> sig v -> sig v gaussian eps ratio freq =-   let var    = ratioFreqToVariance ratio freq+   let var    = Filt.ratioFreqToVariance ratio freq        area   = var * sqrt (2*pi)        gau t  = exp (-(t/var)^2/2) / area        width  = ceiling (var * sqrt (-2 * log eps))  -- inverse gau@@ -211,33 +275,9 @@    (Trans.C a, RealField.C a, Module.C a v, SigG.Transform sig v) =>    a -> a -> sig v -> sig v binomial ratio freq =-   let width = ceiling (2 * ratioFreqToVariance ratio freq ^ 2)+   let width = ceiling (2 * Filt.ratioFreqToVariance ratio freq ^ 2)    in  SigG.drop width .        nest (2*width) (amplifyVector (asTypeOf 0.5 freq) . binomial1)--{--exp (-(t/var)^2/2) / area *> cis (2*pi*f*t)-  == exp (-(t/var)^2/2 +: 2*pi*f*t) / area-  == exp ((-t^2 +: 2*var^2*2*pi*f*t) / (2*var^2)) / area-  == exp ((t^2 - i*2*var^2*2*pi*f*t) / (-2*var^2)) / area-  == exp (((t^2 - i*var^2*2*pi*f)^2 + (var^2*2*pi*f)^2) / (-2*var^2)) / area-  == exp (((t^2 - i*var^2*2*pi*f)^2 / (-2*var^2) - (var*2*pi*f)^2/2)) / area--sumMap (\t -> exp (-(t/var)^2/2) / area *> cis (2*pi*f*t))-       [-infinity..infinity]-  ~ sumMap (\t -> exp (-(t/var)^2/2)) [-infinity..infinity]-       * exp (-(var*2*pi*f)^2/2) / area-  = exp (-(var*2*pi*f)^2/2)--}-{- |-  Compute the variance of the Gaussian-  such that its Fourier transform has value @ratio@ at frequency @freq@.--}-{-# INLINE ratioFreqToVariance #-}-ratioFreqToVariance :: (Trans.C a) => a -> a -> a-ratioFreqToVariance ratio freq =-   sqrt (Additive.negate (2 * log ratio)) / (2*pi*freq)-           -- inverse of the fourier transformed gaussian  {-# INLINE binomial1 #-} binomial1 ::
src/Synthesizer/Generic/Filter/Recursive/Comb.hs view
@@ -28,8 +28,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- |
src/Synthesizer/Generic/Filter/Recursive/Integration.hs view
@@ -13,12 +13,10 @@  import qualified Synthesizer.Generic.Signal as SigG --- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Generic/Filter/Recursive/MovingAverage.hs view
@@ -8,10 +8,10 @@ Portability :  requires multi-parameter type classes  -}-module Synthesizer.Generic.Filter.Recursive.MovingAverage-   (sumsStaticInt,-    modulatedFrac,-    ) where+module Synthesizer.Generic.Filter.Recursive.MovingAverage (+   sumsStaticInt,+   modulatedFrac,+   ) where  import qualified Synthesizer.Generic.Signal  as SigG @@ -24,13 +24,10 @@  import qualified Algebra.Module                as Module import qualified Algebra.RealField             as RealField---- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Generic/Fourier.hs view
@@ -50,8 +50,14 @@ import qualified Synthesizer.State.Analysis as Ana import qualified Synthesizer.State.Signal as SigS +import qualified Control.Monad.Trans.State as State+import Control.Monad (liftM2, )+import Control.Applicative ((<$>), )++import qualified Data.Map as Map+import Data.Tuple.HT (mapPair, )+ import qualified Algebra.Transcendental as Trans--- import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.PrincipalIdealDomain as PID import qualified Algebra.IntegralDomain as Integral@@ -62,13 +68,6 @@ import qualified Number.Complex as Complex import Number.Complex ((+:)) -import qualified Data.Map as Map-import qualified Control.Monad.Trans.State as State-import Control.Monad (liftM2, )-import Control.Applicative ((<$>), )--import Data.Tuple.HT (mapPair, )- import NumericPrelude.Numeric import NumericPrelude.Base hiding (head, ) @@ -145,8 +144,7 @@    (Element y, SigG.Read sig y) =>    sig y -> ((Direction,y), (Direction,y)) directionPrimitiveRootsOfUnity x =-   let (z,zInv) =-          conjugatePrimitiveRootsOfUnity x+   let (z,zInv) = conjugatePrimitiveRootsOfUnity x    in  ((Forward,z), (Backward,zInv))  transformForward ::@@ -691,8 +689,7 @@  {- | For @transformComposite z (n,m) sig@,-the parameters @n@ and @m@ must be relatively prime-and @n*m == length sig@ and @z ^ length sig == 1@.+it must hold @n*m == length sig@ and @z ^ length sig == 1@.  Cooley-Tukey-algorithm -}
src/Synthesizer/Generic/Interpolation.hs view
@@ -24,8 +24,8 @@  import Data.Maybe (fromMaybe, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-* Interpolation with various padding methods -}
src/Synthesizer/Generic/LengthSignal.hs view
@@ -5,10 +5,10 @@ import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.Generic.Cut as CutG -import qualified Algebra.Additive       as Additive- import Data.Monoid (Monoid, mempty, mappend, ) import Data.Tuple.HT (mapSnd, )++import qualified Algebra.Additive       as Additive  import NumericPrelude.Numeric as NP import NumericPrelude.Base hiding (length, splitAt, )
src/Synthesizer/Generic/Noise.hs view
@@ -5,16 +5,16 @@  import qualified Synthesizer.State.Noise as Noise -import qualified Synthesizer.Generic.Signal  as SigG-import qualified Synthesizer.State.Signal      as SigS+import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.State.Signal as SigS -import qualified Algebra.RealRing                  as RealRing+import qualified Algebra.RealRing              as RealRing import qualified Algebra.Ring                  as Ring  import System.Random (Random, RandomGen, randomR, mkStdGen, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-|
src/Synthesizer/Generic/Piece.hs view
@@ -12,21 +12,20 @@    FlatPosition(..),    ) where -import qualified Synthesizer.Generic.Control as Ctrl import qualified Synthesizer.Piecewise as Piecewise-import Synthesizer.Generic.Displacement (raise, )+import Synthesizer.Piecewise (FlatPosition (FlatLeft, FlatRight)) +import qualified Synthesizer.Generic.Control as Ctrl import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.Generic.Signal as SigG--- import qualified Synthesizer.State.Signal as Sig-import Synthesizer.State.Control (splitDurations, FlatPosition(..), )+import Synthesizer.Generic.Displacement (raise, )  import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField import qualified Algebra.Field                 as Field -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   @@ -39,7 +38,7 @@    SigG.concat $ zipWith       (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->            SigG.take n $ Piecewise.computePiece c yi0 yi1 d lazySize t)-      (splitDurations $ map Piecewise.pieceDur xs)+      (Piecewise.splitDurations $ map Piecewise.pieceDur xs)       xs
src/Synthesizer/Generic/Signal.hs view
@@ -14,26 +14,26 @@ In this module we collect functions where the element type is not altered by the function. -}-module Synthesizer.Generic.Signal-   (module Synthesizer.Generic.Signal,-    Cut.null,-    Cut.length,-    Cut.empty,-    Cut.cycle,-    Cut.append,-    Cut.concat,-    Cut.take,-    Cut.drop,-    Cut.dropMarginRem,-    Cut.splitAt,-    Cut.reverse,-    Cut.lengthAtLeast,-    Cut.lengthAtMost,-    Cut.sliceVertical,+module Synthesizer.Generic.Signal (+   module Synthesizer.Generic.Signal,+   Cut.null,+   Cut.length,+   Cut.empty,+   Cut.cycle,+   Cut.append,+   Cut.concat,+   Cut.take,+   Cut.drop,+   Cut.dropMarginRem,+   Cut.splitAt,+   Cut.reverse,+   Cut.lengthAtLeast,+   Cut.lengthAtMost,+   Cut.sliceVertical,    ) where -import Synthesizer.Generic.Cut (append, ) import qualified Synthesizer.Generic.Cut as Cut+import Synthesizer.Generic.Cut (append, )  import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.State.Signal as SigS@@ -43,6 +43,16 @@  import qualified Synthesizer.Plain.Modifier as Modifier +import Foreign.Storable (Storable)++import Control.Monad.Trans.State (runState, runStateT, )++import qualified Data.List.HT as ListHT+import qualified Data.List as List+import Data.Function (fix, )+import Data.Tuple.HT (mapPair, mapFst, fst3, snd3, thd3, )+import Data.Monoid (Monoid, mappend, mempty, )+ import qualified Algebra.ToInteger    as ToInteger import qualified Algebra.ToRational   as ToRational import qualified Algebra.Absolute     as Absolute@@ -61,19 +71,8 @@  import qualified Numeric.NonNegative.Class as NonNeg98 -import Foreign.Storable (Storable)--import Control.Monad.Trans.State (runState, runStateT, )-import Data.Monoid (Monoid, mappend, mempty, )--import Data.Function (fix, )-import qualified Data.List.HT as ListHT-import qualified Data.List.Stream as List-import Data.Tuple.HT (mapPair, mapFst, fst3, snd3, thd3, )- import qualified Test.QuickCheck as QC --- import NumericPrelude.Numeric import qualified Prelude as P import Prelude    (Bool, Int, Maybe(Just), maybe, fst, snd,
src/Synthesizer/Generic/Wave.hs view
@@ -10,8 +10,6 @@ import qualified Algebra.RealField            as RealField import qualified Algebra.RealRing             as RealRing --- import Data.Tuple.HT (swap, )- import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()
src/Synthesizer/Interpolation.hs view
@@ -1,15 +1,27 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Interpolation where+module Synthesizer.Interpolation (+   T(Cons, margin, func),+   Margin(marginOffset, marginNumber),+   cons,+   number,+   offset,+   PrefixReader,+   getNode,+   fromPrefixReader,+   constant,+   ) where  import qualified Synthesizer.State.Signal  as Sig  import Control.Monad.Trans.State (StateT(StateT), evalStateT, ) import Control.Monad.Trans.Writer (Writer, writer, runWriter, )-import Data.Monoid (Sum(Sum), ) import Control.Applicative (Applicative(pure, (<*>)), (<$>), liftA2, )+import Data.Monoid (Sum(Sum), ) -import NumericPrelude.Base+import qualified Test.QuickCheck as QC+ import NumericPrelude.Numeric+import NumericPrelude.Base   @@ -29,6 +41,10 @@           -- ^ interpolation requires 'offset' values before the current     }    deriving (Show, Eq)++instance QC.Arbitrary Margin where+   arbitrary = liftA2 Margin (abs <$> QC.arbitrary) (abs <$> QC.arbitrary)+  cons :: Int -> Int -> (t -> Sig.T y -> y) -> T t y cons num off =
src/Synthesizer/Interpolation/Core.hs view
@@ -13,8 +13,8 @@  import Synthesizer.Utility (affineComb, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Interpolation/Custom.hs view
@@ -27,11 +27,11 @@  import Synthesizer.Interpolation.Class ((+.*), ) +import Control.Applicative.HT (liftA4, ) import Control.Applicative (liftA2, )-import Synthesizer.ApplicativeUtility (liftA4, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Interpolation/Module.hs view
@@ -28,11 +28,11 @@ import qualified Algebra.Module    as Module import qualified Algebra.Field     as Field +import Control.Applicative.HT (liftA4, ) import Control.Applicative (liftA2, )-import Synthesizer.ApplicativeUtility (liftA4, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-| Consider the signal to be piecewise linear. -}
src/Synthesizer/Piecewise.hs view
@@ -1,8 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-} {- | Construction of a data type that describes piecewise defined curves. -} module Synthesizer.Piecewise where +import Data.Ix (Ix, )++import qualified Algebra.RealRing as RealRing++import NumericPrelude.Numeric+import NumericPrelude.Base++ {- ToDo: Make it a new data type with Monoid and Generic.Cut instances.@@ -19,8 +28,7 @@                        -> t  {- duration -}                        -> sig} -pieceFromFunction ::-   (y -> y -> t -> sig) -> Piece t y sig+pieceFromFunction :: (y -> y -> t -> sig) -> Piece t y sig pieceFromFunction = Piece  @@ -89,3 +97,15 @@ (|#) :: y -> (PieceDist t y sig, T t y sig) ->    T t y sig y0 |# (PD d c y1, xs)  =  PieceData c y0 y1 d : xs+++data FlatPosition = FlatLeft | FlatRight+   deriving (Show, Eq, Ord, Ix, Enum)++splitDurations :: (RealRing.C t) => [t] -> [(Int, t)]+splitDurations ts0 =+   let (ds,ts) =+           unzip $ scanl+              (\(_,fr) d -> RealRing.splitFraction (fr+d))+              (0,1) ts0+   in  zip (tail ds) (map (subtract 1) ts)
src/Synthesizer/PiecewiseConstant/Signal.hs view
@@ -13,10 +13,8 @@    ) where  import qualified Data.EventList.Relative.TimeTime  as EventListTT--- import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Data.EventList.Relative.MixedTime as EventListMT import qualified Data.EventList.Relative.BodyTime  as EventListBT--- import qualified Data.EventList.Relative.TimeBody  as EventList  import qualified Numeric.NonNegative.Class   as NonNeg import qualified Numeric.NonNegative.Wrapper as NonNegW
src/Synthesizer/Plain/Analysis.hs view
@@ -1,14 +1,55 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-module Synthesizer.Plain.Analysis where+module Synthesizer.Plain.Analysis (+   volumeMaximum,+   volumeEuclidean,+   volumeEuclideanSqr,+   volumeSum,+   volumeVectorMaximum,+   volumeVectorEuclidean,+   volumeVectorEuclideanSqr,+   volumeVectorSum,+   bounds,+   histogramDiscreteArray,+   histogramLinearArray,+   histogramDiscreteIntMap,+   histogramLinearIntMap,+   histogramIntMap,+   directCurrentOffset,+   scalarProduct,+   centroid,+   centroidAlt,+   firstMoment,+   average,+   rectify,+   zeros, +   BinaryLevel(Low, High),+   binaryLevelFromBool,+   binaryLevelToNumber,+   flipFlopHysteresis,+   flipFlopHysteresisStep,+   chirpTransform,+   binarySign,+   deltaSigmaModulation,+   deltaSigmaModulationPositive,++   -- for testing+   spread,+   ) where+ import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.Plain.Control as Ctrl import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integration --- import qualified Algebra.Module                as Module--- import qualified Algebra.Transcendental        as Trans+import qualified Data.NonEmpty as NonEmpty+import qualified Data.Array as Array+import qualified Data.IntMap as IntMap+import Data.Tuple.HT (sortPair)+import Data.Array (accumArray)+import Data.List (foldl', )+ import qualified Algebra.Algebraic             as Algebraic import qualified Algebra.RealField             as RealField import qualified Algebra.Field                 as Field@@ -21,16 +62,8 @@ import qualified Algebra.NormedSpace.Euclidean as NormedEuc import qualified Algebra.NormedSpace.Sum       as NormedSum -import qualified Data.NonEmpty as NonEmpty-import qualified Data.Array as Array--import qualified Data.IntMap as IntMap--import Data.Array (accumArray)-import Data.List (foldl', )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Notions of volume -}@@ -213,8 +246,8 @@ meanValues = concatMap spread . NonEmpty.mapAdjacent (,)  spread :: RealField.C y => (y,y) -> [(Int,y)]-spread (l0,r0) =-   let (l,r) = if l0<=r0 then (l0,r0) else (r0,l0)+spread lr0 =+   let (l,r) = sortPair lr0        (li,lf) = splitFraction l        (ri,rf) = splitFraction r        k = recip (r-l)@@ -296,12 +329,15 @@ -} flipFlopHysteresis :: (Ord y) =>    (y,y) -> BinaryLevel -> Sig.T y -> Sig.T BinaryLevel-flipFlopHysteresis (lower,upper) =-   scanl-      (\state x -> binaryLevelFromBool $-          case state of+flipFlopHysteresis bnds = scanl (flipFlopHysteresisStep bnds)++flipFlopHysteresisStep :: Ord a => (a, a) -> BinaryLevel -> a -> BinaryLevel+flipFlopHysteresisStep (lower,upper) =+   \state x ->+      binaryLevelFromBool $+         case state of             High -> not(x<lower)-            Low  -> x>upper)+            Low  -> x>upper  {- | Almost naive implementation of the chirp transform,
src/Synthesizer/Plain/Builder.hs view
@@ -10,9 +10,9 @@ import qualified Algebra.FloatingPoint as Float import qualified Algebra.ToInteger as ToInteger -import Prelude ()-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude ()
src/Synthesizer/Plain/Control.hs view
@@ -1,25 +1,48 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-module Synthesizer.Plain.Control where+module Synthesizer.Plain.Control (+   constant,+   linear,+   linearMultiscale,+   linearMultiscaleNeutral,+   linearStable,+   linearMean,+   line,+   exponential, exponentialMultiscale, exponentialStable,+   exponentialMultiscaleNeutral,+   exponential2, exponential2Multiscale, exponential2Stable,+   exponential2MultiscaleNeutral,+   exponentialFromTo, exponentialFromToMultiscale,+   vectorExponential,+   vectorExponential2,+   cosine, cosineMultiscale, cosineSubdiv, cosineStable,+   cubicHermite,+   cubicHermiteStable, -import Synthesizer.Plain.Displacement (raise)+   -- used in Analysis+   curveMultiscale,+   curveMultiscaleNeutral,+   -- used in Generic.Control, Interpolation.Module+   cubicFunc,+   cosineWithSlope,+   ) where  import qualified Synthesizer.Plain.Signal as Sig +import Data.List (zipWith4, tails, )+import Data.List.HT (iterateAssociative, )+ 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.Ring                  as Ring import qualified Algebra.Additive              as Additive  import Number.Complex (cis,real, )-import Data.List (zipWith4, tails, )-import Data.List.HT (iterateAssociative, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Control curve generation -}@@ -69,9 +92,9 @@ namely using a subdivision scheme. The division needed is a division by two. -0       4       8-0   2   4   6   8-0 1 2 3 4 5 6 7 8+> 0       4       8+> 0   2   4   6   8+> 0 1 2 3 4 5 6 7 8 -} linearMean :: Field.C y =>       y@@ -224,11 +247,11 @@    map (cubicFunc node0 node1) (linear 1 0)  {- |-0                                     16-0               8                     16-0       4       8         12          16-0   2   4   6   8   10    12    14    16-0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16+> 0                                     16+> 0               8                     16+> 0       4       8         12          16+> 0   2   4   6   8   10    12    14    16+> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 -} cubicFunc :: Field.C y => (y, (y,y)) -> (y, (y,y)) -> y -> y cubicFunc (t0, (y0,dy0)) (t1, (y1,dy1)) t =@@ -322,126 +345,6 @@   -{-# DEPRECATED Control "use Synthesizer.State.Piece instead" #-}-{- |-The curve type of a piece of a piecewise defined control curve.--}-data Control y =-     CtrlStep-   | CtrlLin-   | CtrlExp {ctrlExpSaturation :: y}-   | CtrlCos-   | CtrlCubic {ctrlCubicGradient0 :: y,-                ctrlCubicGradient1 :: y}-   deriving (Eq, Show)--{- |-The full description of a control curve piece.--}-data ControlPiece y =-     ControlPiece {pieceType :: Control y,-                   pieceY0 :: y,-                   pieceY1 :: y,-                   pieceDur :: y}-   deriving (Eq, Show)---newtype PieceRightSingle y = PRS y-newtype PieceRightDouble y = PRD y--type ControlDist y = (y, Control y, y)----- precedence and associativity like (:)-infixr 5 -|#, #|-, =|#, #|=, |#, #|--{- |-The 6 operators simplify constructing a list of @ControlPiece a@.-The description consists of nodes (namely the curve values at nodes)-and the connecting curve types.-The naming scheme is as follows:-In the middle there is a bar @|@.-With respect to the bar,-the pad symbol @\#@ is at the side of the curve type,-at the other side there is nothing, a minus sign @-@, or an equality sign @=@.-- (1) Nothing means that here is the start or the end node of a curve.-- (2) Minus means that here is a node where left and right curve meet at the same value.-     The node description is thus one value.-- (3) Equality sign means that here is a split node,-     where left and right curve might have different ending and beginning values, respectively.-     The node description consists of a pair of values.--}---- the leading space is necessary for the Haddock parser--( #|-) :: (y, Control y) -> (PieceRightSingle y, [ControlPiece y]) ->-   (ControlDist y, [ControlPiece y])-(d,c) #|- (PRS y1, xs)  =  ((d,c,y1), xs)--(-|#) :: y -> (ControlDist y, [ControlPiece y]) ->-   (PieceRightSingle y, [ControlPiece y])-y0 -|# ((d,c,y1), xs)  =  (PRS y0, ControlPiece c y0 y1 d : xs)--( #|=) :: (y, Control y) -> (PieceRightDouble y, [ControlPiece y]) ->-   (ControlDist y, [ControlPiece y])-(d,c) #|= (PRD y1, xs)  =  ((d,c,y1), xs)--(=|#) :: (y,y) -> (ControlDist y, [ControlPiece y]) ->-   (PieceRightDouble y, [ControlPiece y])-(y01,y10) =|# ((d,c,y11), xs)  =  (PRD y01, ControlPiece c y10 y11 d : xs)--( #|) :: (y, Control y) -> y ->-   (ControlDist y, [ControlPiece y])-(d,c) #| y1  =  ((d,c,y1), [])--(|#) :: y -> (ControlDist y, [ControlPiece y]) ->-   [ControlPiece y]-y0 |# ((d,c,y1), xs)  =  ControlPiece c y0 y1 d : xs---piecewise :: (Trans.C y, RealRing.C y) =>-   [ControlPiece y] -> Sig.T y-piecewise xs =-   let ts = scanl (\(_,fr) d -> splitFraction (fr+d))-                  (0,1) (map pieceDur xs)-   in  concat (zipWith3-          (\n t (ControlPiece c yi0 yi1 d) ->-               piecewisePart yi0 yi1 t d n c)-          (map fst (tail ts)) (map (subtract 1 . snd) ts)-          xs)---piecewisePart :: (Trans.C y) =>-   y -> y -> y -> y -> Int -> Control y -> Sig.T y-piecewisePart y0 y1 t0 d n ctrl =-   take n-      (case ctrl of-         CtrlStep  -> constant y0-         CtrlLin   -> let s = (y1-y0)/d in linearStable s (y0-t0*s)-         CtrlExp s -> let y0' = y0-s; y1' = y1-s; yd = y0'/y1'-                      in  raise s (exponentialStable (d / log yd)-                                           (y0' * yd**(t0/d)))-         CtrlCos   -> map (\y -> (1+y)*(y0/2)+(1-y)*(y1/2))-                          (cosineStable t0 (t0+d))-         CtrlCubic yd0 yd1 ->-            cubicHermiteStable (t0,(y0,yd0)) (t0+d,(y1,yd1)))--{--  exp (-1/time) == yd**(-1/d)-  1/time == log yd / d-  time   == d / log yd--}--{--  piecewise (0 |# (10.21, CtrlExp 1.1) #|- 1 -|# (10,CtrlExp 0.49) #|- 0.5 -|# (30, CtrlLin) #|- 0.5 -|# (20, CtrlCos) #| 0)--  piecewise (0 |# (10.21, CtrlExp 1.1) #|- 1 -|# (10,CtrlCubic (-0.1) 0) #|- 0.5 -|# (30, CtrlLin) #|- 0.5 -|# (20, CtrlCos) #| 0)--}-- {- * Auxiliary functions -}  curveStable :: (Additive.C t) =>@@ -476,8 +379,8 @@ subdivide _ [] = []  -concatMapPair' :: (a -> (b,b)) -> Sig.T a -> Sig.T b-concatMapPair' f = concatMap ((\(x,y) -> [x,y]) . f)+_concatMapPair :: (a -> (b,b)) -> Sig.T a -> Sig.T b+_concatMapPair f = concatMap ((\(x,y) -> [x,y]) . f)   curveMultiscale :: (y -> y -> y) -> y -> y -> Sig.T y
src/Synthesizer/Plain/Cut.hs view
@@ -22,16 +22,16 @@  import qualified Data.EventList.Relative.TimeBody as EventList +import Data.Array (Array, Ix, (!))+ import qualified MathObj.LaurentPolynomial as Laurent-import qualified Algebra.RealRing     as RealRing+import qualified Algebra.RealRing as RealRing import qualified Algebra.Additive as Additive -import Data.Array (Array, Ix, (!))- import qualified Number.NonNegative as NonNeg -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Displacement.hs view
@@ -8,9 +8,8 @@  import qualified Synthesizer.Plain.Signal as Sig --- import qualified Prelude as P-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Mixing -}
src/Synthesizer/Plain/Effect.hs view
@@ -3,11 +3,8 @@ import qualified Synthesizer.Plain.Noise as Noise import qualified Synthesizer.Plain.Filter.Recursive as Filter import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder  as Filt1--- import qualified Synthesizer.Plain.Filter.Recursive.Allpass     as Allpass--- import qualified Synthesizer.Plain.Filter.Recursive.Universal   as UniFilter import qualified Synthesizer.Plain.Filter.Recursive.Moog        as Moog import qualified Synthesizer.Plain.Filter.Recursive.Comb        as Comb--- import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integrate import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butter import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev   as Cheby import Synthesizer.Plain.Control(exponential2)@@ -18,6 +15,7 @@ import qualified Control.Monad.Exception.Synchronous as Exc import System.Process (rawSystem, ) import System.Exit (ExitCode, )+  main :: IO ExitCode main =
src/Synthesizer/Plain/Effect/Fly.hs view
@@ -16,8 +16,8 @@  import qualified Algebra.NormedSpace.Euclidean as Euc -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-
src/Synthesizer/Plain/Effect/Glass.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Plain.Effect.Glass where+module Synthesizer.Plain.Effect.Glass (glass) where  import qualified Data.EventList.Relative.TimeBody as EventList import qualified Number.NonNegative as NonNeg@@ -11,18 +11,18 @@ import qualified Synthesizer.Plain.Noise      as Noise import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR -import qualified Algebra.Transcendental as Trans-import qualified Algebra.RealField      as RealField-import qualified Algebra.Module         as Module- import System.Random(randomRs, mkStdGen)  import qualified Data.List.HT as ListHT -import NumericPrelude.Base-import NumericPrelude.Numeric as NP+import qualified Algebra.Transcendental as Trans+import qualified Algebra.RealField      as RealField+import qualified Algebra.Module         as Module +import NumericPrelude.Numeric+import NumericPrelude.Base as NP + {- | We try to simulate the sound of broken glass      as a mixture of short percussive sounds with random pitch -} glass :: Double -> [Double]@@ -52,12 +52,12 @@                 (Osci.static Wave.square 0 (freq/sampleRate))                 (Ctrl.exponential2 (0.01*sampleRate) amp)) -densitySmooth, densityHeavy :: Trans.C a => a -> a-densitySmooth x = x * exp(-10*x*x)+_densitySmooth, densityHeavy :: Trans.C a => a -> a+_densitySmooth x = x * exp(-10*x*x) densityHeavy  x = 0.4 * exp (-4*x) -timeDiffsAlt :: [Bool] -> [NonNeg.Int]-timeDiffsAlt =+_timeDiffs :: [Bool] -> [NonNeg.Int]+_timeDiffs =    let diffs n (True  : xs) = n : diffs 1 xs        diffs n (False : xs) = diffs (succ n) xs        diffs _ [] = []
src/Synthesizer/Plain/File.hs view
@@ -35,21 +35,22 @@ import Foreign.Storable (Storable, ) import Data.Int (Int16, ) -import qualified Control.Monad.Exception.Synchronous as Exc-import Control.Monad.Trans.Class (lift, )+import qualified System.FilePath as FilePath import System.Process (rawSystem, ) import System.Exit (ExitCode, )++import qualified Control.Monad.Exception.Synchronous as Exc+import Control.Monad.Trans.Class (lift, ) import Control.Monad (liftM2, )+ import Data.Monoid (mconcat, )  import qualified Algebra.ToInteger          as ToInteger import qualified Algebra.RealRing           as RealRing import qualified Algebra.Field              as Field -import qualified System.FilePath as FilePath--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Delay.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Plain.Filter.Delay where+module Synthesizer.Plain.Filter.Delay (+   phaser,+   plane, +   -- for testing+   propAll,+   ) where+ import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR import qualified Synthesizer.Plain.Displacement as Syn import qualified Synthesizer.Plain.Control as Ctrl@@ -16,8 +22,8 @@ import qualified Synthesizer.Plain.Filter.Delay.List  as DelayList import qualified Synthesizer.Plain.Filter.Delay.Block as DelayBlock -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   phaser :: (Module.C a v, RealField.C a) => a -> [a] -> [v] -> [v]
src/Synthesizer/Plain/Filter/Delay/Block.hs view
@@ -5,8 +5,13 @@ In contrast to ring buffers, block lists allow infinite look ahead. -}-module Synthesizer.Plain.Filter.Delay.Block where+module Synthesizer.Plain.Filter.Delay.Block (+   modulated, +   -- for testing+   propDrop,+   ) where+ import qualified Synthesizer.Plain.Interpolation as Interpolation import qualified Synthesizer.Plain.Signal as Sig @@ -18,8 +23,8 @@  import Test.QuickCheck ((==>), Property) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   modulatedCore :: (RealField.C a, Additive.C v) =>@@ -78,11 +83,11 @@ Drop elements from a blocked list. The offset must lie in the leading block. -}-dropSingleBlocksToList :: Int -> BlockList a -> Sig.T a-dropSingleBlocksToList number (arr:arrs) =+_dropSingleBlocksToList :: Int -> BlockList a -> Sig.T a+_dropSingleBlocksToList number (arr:arrs) =    map (arr!) [number .. (snd $ bounds arr)] ++    concatMap elems arrs-dropSingleBlocksToList _ [] = []+_dropSingleBlocksToList _ [] = []   suffixIndexes :: BlockList a -> [(Int, BlockList a)]
src/Synthesizer/Plain/Filter/Delay/List.hs view
@@ -1,15 +1,15 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Plain.Filter.Delay.List where+module Synthesizer.Plain.Filter.Delay.List (modulated, modulatedRev) where  import qualified Synthesizer.Plain.Interpolation as Interpolation +import Data.List(tails)+ import qualified Algebra.RealField as RealField import qualified Algebra.Additive  as Additive -import Data.List(tails)--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- |
src/Synthesizer/Plain/Filter/Delay/ST.hs view
@@ -3,7 +3,7 @@ An implementation of a Delay using a classical circular buffer running in the State Thread monad. -}-module Synthesizer.Plain.Filter.Delay.ST where+module Synthesizer.Plain.Filter.Delay.ST (modulated) where  import qualified Synthesizer.Plain.Interpolation as Interpolation @@ -13,8 +13,8 @@ import Control.Monad.ST.Lazy(runST,strictToLazyST,ST) import Data.Array.ST -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-
src/Synthesizer/Plain/Filter/LinearPredictive.hs view
@@ -1,10 +1,11 @@ module Synthesizer.Plain.Filter.LinearPredictive where -import qualified Algebra.Field    as Field import Synthesizer.Plain.Analysis (scalarProduct)  import qualified Data.List.Match as ListMatch import qualified Data.List as List++import qualified Algebra.Field    as Field  import NumericPrelude.Numeric import NumericPrelude.Base
src/Synthesizer/Plain/Filter/NonRecursive.hs view
@@ -7,8 +7,49 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.Plain.Filter.NonRecursive where+module Synthesizer.Plain.Filter.NonRecursive (+   amplify,+   amplifyVector,+   binomial,+   binomial1,+   delay,+   delayPad,+   differentiate,+   differentiate2,+   differentiateCenter,+   downsample2,+   envelope,+   envelopeVector,+   fadeInOut,+   fadeInOutAlt,+   gaussian,+   generic,+   genericAlt,+   minRange,+   movingAverageModulatedPyramid,+   sumRange,+   sumRangeFromPyramid,+   sums,+   sumsDownsample2,+   sumsPosModulated,+   sumsPosModulatedPyramid,+   sumsPyramid, +   -- for testing+   propGeneric,+   sumRangeFromPyramidFoldr,+   sumRangeFromPyramidRec,+   getRangeFromPyramid,+   pyramid,+   ) where++import Synthesizer.Basic.Filter.NonRecursive (+   unitSizesFromPyramid,+   sumRangePrepare,+   symmetricRangePrepare,+   ratioFreqToVariance,+   )+ import qualified Synthesizer.Plain.Control as Ctrl import qualified Synthesizer.Plain.Signal  as Sig @@ -22,17 +63,12 @@ import Algebra.Module(linearComb, )  import Data.Function.HT (nest, )-import Data.Tuple.HT (mapPair, swap, )+import Data.Tuple.HT (mapPair, ) import Data.List.HT (sliceVertical, ) import Data.List (tails, ) -import qualified Data.List.Match as Match---- import Control.Monad.Trans.State (StateT)--- import Control.Monad.Trans.Writer (WriterT)--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Envelope application -}@@ -153,29 +189,6 @@    let width = ceiling (2 * ratioFreqToVariance ratio freq ^ 2)    in  drop width . nest (2*width) ((asTypeOf 0.5 freq *>) . binomial1) -{--exp (-(t/var)^2/2) / area *> cis (2*pi*f*t)-  == exp (-(t/var)^2/2 +: 2*pi*f*t) / area-  == exp ((-t^2 +: 2*var^2*2*pi*f*t) / (2*var^2)) / area-  == exp ((t^2 - i*2*var^2*2*pi*f*t) / (-2*var^2)) / area-  == exp (((t^2 - i*var^2*2*pi*f)^2 + (var^2*2*pi*f)^2) / (-2*var^2)) / area-  == exp (((t^2 - i*var^2*2*pi*f)^2 / (-2*var^2) - (var*2*pi*f)^2/2)) / area--sumMap (\t -> exp (-(t/var)^2/2) / area *> cis (2*pi*f*t))-       [-infinity..infinity]-  ~ sumMap (\t -> exp (-(t/var)^2/2)) [-infinity..infinity]-       * exp (-(var*2*pi*f)^2/2) / area-  = exp (-(var*2*pi*f)^2/2)--}-{- |-  Compute the variance of the Gaussian-  such that its Fourier transform has value @ratio@ at frequency @freq@.--}-ratioFreqToVariance :: (Trans.C a) => a -> a -> a-ratioFreqToVariance ratio freq =-   sqrt (-2 * log ratio) / (2*pi*freq)-           -- inverse of the fourier transformed gaussian- binomial1 :: (Additive.C v) => Sig.T v -> Sig.T v binomial1 xt@(x:xs) = x : (xs + xt) binomial1 [] = []@@ -262,19 +275,6 @@ pyramid :: (Additive.C v) => Sig.T v -> [Sig.T v] pyramid = iterate sumsDownsample2 -unitSizesFromPyramid :: [signal] -> [Int]-unitSizesFromPyramid pyr =-   reverse $ Match.take pyr $ iterate (2*) 1--sumRangePrepare :: (Additive.C v) =>-   ((Int,Int) -> source -> v) ->-   (source -> (Int,Int) -> v)-sumRangePrepare f pyr (l,r) =-   case compare l r of-      LT -> f (l,r) pyr-      GT -> negate $ f (r,l) pyr-      EQ -> zero- {- | This function should be much faster than 'sumRange' but slower than the recursively implemented @movingAverage@.@@ -285,12 +285,6 @@ sumRangeFromPyramid =    sumRangePrepare $ \lr0 pyr0 ->    sum $ getRangeFromPyramid pyr0 lr0--symmetricRangePrepare ::-   ((Int,Int) -> source -> v) ->-   (source -> (Int,Int) -> v)-symmetricRangePrepare f pyr lr =-   f (if uncurry (<) lr then lr else swap lr) pyr  minRange :: (Ord v) => Sig.T v -> (Int,Int) -> v minRange =
src/Synthesizer/Plain/Filter/Recursive.hs view
@@ -14,8 +14,8 @@ import qualified Algebra.Module                as Module import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Various Filters -}
src/Synthesizer/Plain/Filter/Recursive/Allpass.hs view
@@ -9,16 +9,50 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.Plain.Filter.Recursive.Allpass where+module Synthesizer.Plain.Filter.Recursive.Allpass (+   Parameter(Parameter, getParameter),+   State,+   cascade,+   cascadeCausal,+   cascadeModifier,+   cascadeParameter,+   cascadeStep,+   cascadeDiverseStep,+   firstOrder,+   firstOrderCausal,+   firstOrderModifier,+   firstOrderStep,+   flangerParameter,+   flangerPhase,+   makePhase,+   parameter,+   parameterApprox, +   -- for testing+   parameterAlt,+   cascadeState,+   cascadeIterative,+   cascadeStepRec,+   cascadeStepScanl,+   cascadeStepStack,+   cascadeCausalModifier,+   cascadeCausalStacked,+   ) where+ import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier import qualified Synthesizer.Causal.Process as Causal  import qualified Synthesizer.Interpolation.Class as Interpol++import qualified Control.Monad.Trans.State as MS import qualified Control.Applicative as App+ import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav+import Data.Tuple.HT (mapSnd, )+import Data.Function.HT (nest, )+import Data.List.HT (mapAdjacent, switchR, )  import qualified Foreign.Storable.Newtype as Store import Foreign.Storable (Storable(sizeOf, alignment, peek, poke))@@ -31,14 +65,9 @@ import qualified Algebra.ZeroTestable          as ZeroTestable  import qualified Number.Complex as Complex-import Data.Tuple.HT (mapSnd, )-import Data.Function.HT (nest, )-import Data.List.HT (mapAdjacent, switchR, ) -import qualified Control.Monad.Trans.State as MS--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Recursive/AllpassPoly.hs view
@@ -11,9 +11,6 @@ -} module Synthesizer.Plain.Filter.Recursive.AllpassPoly where --- import qualified Synthesizer.Plain.Signal   as Sig--- import qualified Synthesizer.Plain.Modifier as Modifier- import qualified Algebra.Module                as Module import qualified Algebra.RealTranscendental    as RealTrans import qualified Algebra.Transcendental        as Trans@@ -25,8 +22,8 @@ import Orthogonals(Scalar,one_ket_solution)  import qualified Prelude as P-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Recursive/Butterworth.hs view
@@ -11,12 +11,27 @@  Butterworth lowpass and highpass -}-module Synthesizer.Plain.Filter.Recursive.Butterworth where+module Synthesizer.Plain.Filter.Recursive.Butterworth (+   Parameter,+   causal,+   causalPole,+   highpassCausalPole, highpassPole,+   lowpassCausalPole,  lowpassPole,+   modifier,+   parameter,+   partialParameter,+   runPole, +   -- used in Dimensional.Causal.FilterParameter+   checkedHalf,+   -- used in LLVM.Filter.Butterworth+   partialRatio,+   makeSines,+   ) where+ import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass), Pole(Pole)) import qualified Synthesizer.Plain.Filter.Recursive.SecondOrderCascade as Cascade import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2--- import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder  as Filt1 import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier import qualified Synthesizer.Causal.Process as Causal@@ -29,15 +44,15 @@ import qualified Data.StorableVector as SV import Foreign.Storable (Storable) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   -sineList, sineListSlow, sineListFast :: (Trans.C a) => a -> [a]+sineList, _sineListSlow, sineListFast :: (Trans.C a) => a -> [a] sineList = sineListFast -sineListSlow x =+_sineListSlow x =    map sin $ map (x*) $ iterate (2+) 1  sineListFast x =@@ -60,11 +75,11 @@   -partialLowpassParameterInstable, partialLowpassParameter :: (Trans.C a) =>+_partialLowpassParameterInstable, partialLowpassParameter :: (Trans.C a) =>    a -> a -> a -> Filt2.Parameter a  {- must handle infinite values when 'freq' approaches 0.5 -}-partialLowpassParameterInstable ratio freq sinw =+_partialLowpassParameterInstable ratio freq sinw =    let wc    = ratio * tan (pi*freq)        sinw2 = 2 * wc * sinw        wc2   = wc * wc
src/Synthesizer/Plain/Filter/Recursive/Chebyshev.hs view
@@ -11,14 +11,24 @@  Chebyshev lowpass and highpass -}-module Synthesizer.Plain.Filter.Recursive.Chebyshev where+module Synthesizer.Plain.Filter.Recursive.Chebyshev (+   ParameterA, parameterA, partialParameterA,+   ParameterB, parameterB, partialParameterB,+   canonicalizeParameterA,+   causalA, runAPole, causalAPole,+   causalB, runBPole, causalBPole,+   lowpassACausalPole, highpassACausalPole,+   lowpassBCausalPole, highpassBCausalPole,+   lowpassAPole, highpassAPole,+   lowpassBPole, highpassBPole,+   -- used in LLVM.Filter.Chebyshev+   makeCirclePoints,+   ) where  import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass), Pole(Pole, poleResonance)) import qualified Synthesizer.Plain.Filter.Recursive.SecondOrderCascade as Cascade import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2--- import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder  as Filt1 import qualified Synthesizer.Plain.Signal   as Sig--- import qualified Synthesizer.Plain.Modifier as Modifier import qualified Synthesizer.Causal.Process as Causal import Control.Arrow ((>>>), (^>>), (&&&), ) @@ -33,19 +43,19 @@ import qualified Data.StorableVector as SV import Foreign.Storable (Storable) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base    -circleList, circleListSlow, circleListFast :: (Trans.C a) => a -> [Complex.T a]+circleList, circleListSlow, _circleListFast :: (Trans.C a) => a -> [Complex.T a] circleList = circleListSlow  circleListSlow x =    map cis $ map (x*) $ iterate (2+) 1 -circleListFast x =+_circleListFast x =    let z1 = cis x        z2 = z1^2    in  iterate (z2*) z1
src/Synthesizer/Plain/Filter/Recursive/Comb.hs view
@@ -14,18 +14,17 @@ -} module Synthesizer.Plain.Filter.Recursive.Comb where -import Synthesizer.Plain.Filter.NonRecursive (delay, ) import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1-import qualified Synthesizer.Plain.Signal   as Sig--- import qualified Synthesizer.Plain.Modifier as Modifier+import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.Plain.Control as Ctrl+import Synthesizer.Plain.Filter.NonRecursive (delay, )  import qualified Algebra.Module                as Module import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- |
src/Synthesizer/Plain/Filter/Recursive/FirstOrder.hs view
@@ -18,8 +18,11 @@ import qualified Synthesizer.Causal.Process as Causal  import qualified Synthesizer.Interpolation.Class as Interpol-import Control.Applicative (pure, liftA2, )+ import qualified Control.Applicative as App+import Control.Monad.Trans.State (State, state, )+import Control.Applicative (pure, liftA2, )+ import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav @@ -29,14 +32,11 @@  import qualified Algebra.Module                as Module import qualified Algebra.Transcendental        as Trans--- import qualified Algebra.Field                 as Field import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import Control.Monad.Trans.State (State, state, )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   @@ -155,8 +155,7 @@   -data Result a =-        Result {highpass_, lowpass_ :: !a}+data Result a = Result {highpass_, lowpass_ :: !a}  instance Functor Result where    {-# INLINE fmap #-}
src/Synthesizer/Plain/Filter/Recursive/FirstOrderComplex.hs view
@@ -43,8 +43,8 @@  import Control.Monad.Trans.State (State, state, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   data Parameter a =
src/Synthesizer/Plain/Filter/Recursive/Hilbert.hs view
@@ -15,25 +15,39 @@ ToDo: More parameters for controling the affected frequency range. -}-module Synthesizer.Plain.Filter.Recursive.Hilbert where+module Synthesizer.Plain.Filter.Recursive.Hilbert (+   Parameter (Parameter, parameterCosine, parameterSine),+   polesCosine, polesSine,+   parameter,+   step2,+   modifierInit2,+   runInit2, run2,+   cascade,+   causal2, causalComplex2,+   causal,  causalComplex, -import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass+   lowpassStream,+   lowpassMaintainPhase,+   ) where +import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier-import qualified Synthesizer.Causal.Process as Causal-import Control.Arrow ((<<<), (>>>), (&&&), (>>^), )- import qualified Synthesizer.Plain.Oscillator as Osci+import qualified Synthesizer.Causal.Process as Causal import qualified Synthesizer.Basic.Wave       as Wave+import qualified Synthesizer.Basic.ComplexModule as CM  {- import qualified Synthesizer.Plain.Control as Ctrl import qualified Graphics.Gnuplot.Simple as Gnuplot -} -import qualified Synthesizer.Basic.ComplexModule as CM+import Control.Arrow ((<<<), (>>>), (&&&), (>>^), )+import Control.Monad.Trans.State (State, state, runState, ) +import qualified Data.List.Match as Match+ import qualified Algebra.Module                as Module import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField@@ -43,12 +57,8 @@ import qualified Number.Complex as Complex import Number.Complex ((+:), ) -import Control.Monad.Trans.State (State, state, runState, )--import qualified Data.List.Match as Match--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Recursive/Integration.hs view
@@ -12,14 +12,11 @@ module Synthesizer.Plain.Filter.Recursive.Integration where  import qualified Synthesizer.Plain.Signal   as Sig--- import qualified Synthesizer.Plain.Modifier as Modifier --- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Recursive/Moog.hs view
@@ -11,7 +11,14 @@  Moog cascade lowpass with resonance. -}-module Synthesizer.Plain.Filter.Recursive.Moog where+module Synthesizer.Plain.Filter.Recursive.Moog (+   Parameter(Parameter, feedback, lowpassParam),+   parameter,+   State,+   lowpass,+   lowpassModifier,+   lowpassCausal,+   ) where  import Synthesizer.Plain.Filter.Recursive (Pole(..)) import Synthesizer.Plain.Filter.NonRecursive (envelopeVector)@@ -21,22 +28,22 @@ import qualified Synthesizer.Causal.Process as Causal  import qualified Synthesizer.Interpolation.Class as Interpol-import Control.Applicative (pure, liftA2, (<*>), )++import qualified Control.Monad.Trans.State as MS import qualified Control.Applicative as App+import Control.Arrow ((&&&), (>>^), (^>>), )+import Control.Applicative (pure, liftA2, (<*>), )+ import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav+import Data.Function.HT (nest, )  import qualified Algebra.Module                as Module import qualified Algebra.Transcendental        as Trans import qualified Algebra.Ring                  as Ring -import Data.Function.HT (nest, )--import qualified Control.Monad.Trans.State as MS-import Control.Arrow ((&&&), (>>^), (^>>), )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   data Parameter a =@@ -78,8 +85,8 @@ {- For small frequencies we get cancellations and division zero by zero. -}-parameterInstable :: Trans.C a => Int -> Pole a -> Parameter a-parameterInstable order (Pole resonance frequency) =+_parameterInstable :: Trans.C a => Int -> Pole a -> Parameter a+_parameterInstable order (Pole resonance frequency) =     let beta  = frequency * 2 * pi         alpha = (pi-beta) / fromIntegral order         k     = sin alpha / sin (alpha+beta)@@ -117,7 +124,7 @@ type State = []  {--Used for lowpassState,+Used for _lowpassState, list of internal values may be processed by Applicative.traverse. -} lowpassStepStack :: (Ring.C a, Module.C a v) =>@@ -127,9 +134,9 @@       y1 <- Modifier.stackStatesR (Filt1.lowpassStep k) (x - f *> y0)       return ((1+f) *> y1) -lowpassStepRev :: (Ring.C a, Module.C a v) =>+_lowpassStepRev :: (Ring.C a, Module.C a v) =>    Parameter a -> v -> MS.State (State v) v-lowpassStepRev (Parameter f k) x = MS.state $ \s ->+_lowpassStepRev (Parameter f k) x = MS.state $ \s ->     let news =            tail (scanl               (MS.evalState . Filt1.lowpassStep k)@@ -146,8 +153,8 @@  {-# INLINE lowpassCausal #-} {-# INLINE lowpassCausalStacked #-}-{-# INLINE lowpassCausalModifier #-}-lowpassCausal, lowpassCausalStacked, lowpassCausalModifier ::+{-# INLINE _lowpassCausalModifier #-}+lowpassCausal, lowpassCausalStacked, _lowpassCausalModifier ::    (Ring.C a, Module.C a v) =>    Int -> Causal.T (Parameter a, v) v lowpassCausal = lowpassCausalStacked@@ -160,11 +167,11 @@       (snd ^>> Causal.consInit zero)     >>^ (\((Parameter f _k),y1) -> (1+f) *> y1) -lowpassCausalModifier order =+_lowpassCausalModifier order =    Causal.fromSimpleModifier (lowpassModifier order)  -lowpass, lowpassState, lowpassRecursive ::+lowpass, _lowpassState, lowpassRecursive ::    (Ring.C a, Module.C a v) =>    Int -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v @@ -172,7 +179,7 @@ lowpass = lowpassRecursive  {-| Simulate the Moog cascade by a list of states of the partial lowpasses -}-lowpassState order =+_lowpassState order =    Sig.modifyModulated (lowpassModifier order)  {-| The elegant way of implementing the Moog cascade by recursion -}
src/Synthesizer/Plain/Filter/Recursive/MovingAverage.hs view
@@ -7,29 +7,25 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.Plain.Filter.Recursive.MovingAverage-   (sumsStaticInt,-    modulatedFrac,-    ) where+module Synthesizer.Plain.Filter.Recursive.MovingAverage (+   sumsStaticInt,+   modulatedFrac,+   ) where  import qualified Synthesizer.Plain.Signal   as Sig--- import qualified Synthesizer.Plain.Modifier as Modifier import qualified Synthesizer.Plain.Filter.Recursive.Integration as Integration  import Synthesizer.Plain.Filter.NonRecursive (delay, )  import qualified Algebra.Module                as Module import qualified Algebra.RealField             as RealField---- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive  import Control.Monad.Fix (fix) import Data.List (tails) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Recursive/SecondOrder.hs view
@@ -13,17 +13,30 @@ can be decomposed into first order and second order filters with real coefficients. This follows from the Fundamental theorem of algebra. -}-module Synthesizer.Plain.Filter.Recursive.SecondOrder where+module Synthesizer.Plain.Filter.Recursive.SecondOrder (+   Parameter (Parameter, c0, c1, c2, d1, d2),+   State (State, u1, u2, y1, y2),+   adjustPassband,+   amplify,+   causal,+   modifier,+   modifierInit,+   run,+   runInit,+   step,+   zeroState,+   ) where -import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass)) import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier--- import qualified Synthesizer.Plain.Control as Ctrl+import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass))  import qualified Synthesizer.Interpolation.Class as Interpol-import Synthesizer.ApplicativeUtility (liftA4, liftA5, )-import Control.Applicative (pure, )+ import qualified Control.Applicative as App+import Control.Applicative.HT (liftA4, liftA5, )+import Control.Applicative (pure, )+ import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav @@ -38,11 +51,11 @@  import qualified Control.Monad.Trans.State as MS -import Foreign.Storable (Storable(..)) import qualified Foreign.Storable.Record as Store+import Foreign.Storable (Storable(..)) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- | Parameters for a general recursive filter of 2nd order. -}
src/Synthesizer/Plain/Filter/Recursive/SecondOrderCascade.hs view
@@ -16,13 +16,18 @@ This implements a cascade of second order filters using StorableVectors for state and filter parameters. -}-module Synthesizer.Plain.Filter.Recursive.SecondOrderCascade where+module Synthesizer.Plain.Filter.Recursive.SecondOrderCascade (+   Parameter (Parameter),+   State,+   step,+   modifierInit,+   modifier,+   causal,+   ) where  import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2--- import Synthesizer.Plain.Filter.Recursive (Passband(Lowpass,Highpass)) import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier--- import qualified Synthesizer.Plain.Control as Ctrl import qualified Synthesizer.Interpolation.Class as Interpol  import qualified Synthesizer.Causal.Process as Causal@@ -35,8 +40,8 @@ import qualified Data.StorableVector as SV import Foreign.Storable (Storable(..)) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-
src/Synthesizer/Plain/Filter/Recursive/Test.hs view
@@ -18,8 +18,8 @@ import qualified Algebra.Transcendental      as Trans import qualified Algebra.Ring                as Ring -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   sampleRate :: Ring.C a => a
src/Synthesizer/Plain/Filter/Recursive/Universal.hs view
@@ -12,8 +12,24 @@ State variable filter. One filter that generates lowpass, bandpass, highpass, bandlimit at once. -}-module Synthesizer.Plain.Filter.Recursive.Universal where+module Synthesizer.Plain.Filter.Recursive.Universal (+   Parameter(..),+   Result(..),+   State,+   causal,+   modifier,+   modifierInit,+   parameter,+   parameterToSecondOrderLowpass,+   run,+   runInit,+   step, +   -- for testing+   parameterAlt,+   parameterOld,+   ) where+ import Synthesizer.Plain.Filter.Recursive (Pole(..)) import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier@@ -22,9 +38,12 @@ import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as SecondOrder  import qualified Synthesizer.Interpolation.Class as Interpol-import Synthesizer.ApplicativeUtility (liftA4, liftA6, )-import Control.Applicative (pure, liftA2, )++import qualified Control.Monad.Trans.State as MS import qualified Control.Applicative as App+import Control.Applicative.HT (liftA4, liftA6, )+import Control.Applicative (pure, liftA2, )+ import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav @@ -36,10 +55,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import qualified Control.Monad.Trans.State as MS--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   data Parameter a =
src/Synthesizer/Plain/IO.hs view
@@ -18,17 +18,14 @@ import Control.Exception (bracket, ) import Control.Monad (liftM, ) -import Data.Monoid (mconcat, )- import qualified Data.ByteString.Lazy as B import qualified Data.Binary.Builder as Builder-+import Data.Monoid (mconcat, ) import Data.Char (ord, ) -import qualified Prelude as P98--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base+import qualified Prelude as P98
src/Synthesizer/Plain/Instrument.hs view
@@ -26,8 +26,8 @@ import qualified Algebra.Field          as Field import qualified Algebra.Ring           as Ring -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/Plain/Interpolation.hs view
@@ -14,7 +14,8 @@     Interpolation.Margin, Interpolation.margin, -   singleRec, -- for testing+   -- for testing+   singleRec,    ) where  import qualified Synthesizer.Interpolation as Interpolation@@ -27,19 +28,19 @@ import qualified Synthesizer.Plain.Signal  as Sig import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR +import Control.Monad (guard, )++import qualified Data.List.HT as ListHT+import Data.Maybe (fromMaybe)+ import qualified Algebra.Module    as Module import qualified Algebra.RealField as RealField import qualified Algebra.RealRing  as RealRing import qualified Algebra.Ring      as Ring import qualified Algebra.Additive  as Additive -import Data.Maybe (fromMaybe)-import qualified Data.List.HT as ListHT--import Control.Monad (guard, )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-* Interpolation with various padding methods -}
src/Synthesizer/Plain/LorenzAttractor.hs view
@@ -4,8 +4,8 @@ import qualified Algebra.Module as Module import qualified Algebra.Ring   as Ring -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   computeDerivatives :: (Ring.C y) =>
src/Synthesizer/Plain/Noise.hs view
@@ -4,15 +4,15 @@  import qualified Synthesizer.Plain.Signal as Sig -import qualified Algebra.RealRing                  as RealRing+import qualified Algebra.RealRing              as RealRing import qualified Algebra.Ring                  as Ring  import System.Random (Random, RandomGen, randomRs, mkStdGen, )  import Data.List.HT (sliceVertical, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-|
src/Synthesizer/Plain/Play.hs view
@@ -12,18 +12,15 @@  import Foreign.Storable (Storable, ) import Data.Int (Int16, )- import Data.Monoid (mconcat, ) --- import qualified Synthesizer.Frame.Stereo as Stereo+import System.Exit (ExitCode, )  import qualified Algebra.ToInteger as ToInteger import qualified Algebra.RealRing as RealRing -import System.Exit (ExitCode, )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- |
src/Synthesizer/Plain/Signal.hs view
@@ -184,16 +184,15 @@    in  (zipWith f prefixX prefixY,         (second, if second then suffixY else suffixX)) -zipWithRest' ::+zipWithRestRec ::    (y0 -> y0 -> y1) ->    T y0 -> T y0 ->    (T y1, (Bool, T y0))-zipWithRest' f =+zipWithRestRec f =    let recourse xt yt =           forcePair $           case (xt,yt) of-             (x:xs, y:ys) ->-                mapFst (f x y :) (recourse xs ys)+             (x:xs, y:ys) -> mapFst (f x y :) (recourse xs ys)              ([], _) -> ([], (True,  yt))              (_, []) -> ([], (False, xt))    in  recourse
src/Synthesizer/Plain/ToneModulation.hs view
@@ -46,15 +46,49 @@ We have to interpolate in the parallelograms.  -}-module Synthesizer.Plain.ToneModulation where+module Synthesizer.Plain.ToneModulation (+   Cell,+   interpolateCell, +   Prototype,+   makePrototype,+   sampledToneCell,++   oscillatorCells,+   seekCell,+   oscillatorSuffixes,++   -- this function fits better in the Oscillator module+   freqsToPhases,++   -- for testing+   dropFrac,+   dropRem,+   propDropFrac,+   propDropRem,+   oscillatorCoords,+   integrateFractional,+   limitRelativeShapes,+   limitMinRelativeValues,+   limitMaxRelativeValues,+   limitMaxRelativeValuesNonNeg,+   ) where+ import qualified Synthesizer.Basic.ToneModulation as ToneMod import qualified Synthesizer.Basic.Phase as Phase  import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.Plain.Interpolation as Interpolation import Synthesizer.Interpolation (Margin, )++import Control.Monad (guard, )++import qualified Data.List       as List+import qualified Data.List.HT    as ListHT+import qualified Data.List.Match as ListMatch import Data.Array (Array, (!), listArray, )+import Data.Tuple.HT (mapPair, mapSnd, forcePair, )+import Data.Ord.HT (limit, )  import qualified Algebra.RealField             as RealField import qualified Algebra.RealRing              as RealRing@@ -64,17 +98,7 @@ import qualified Number.NonNegative       as NonNeg import qualified Number.NonNegativeChunky as Chunky -import Control.Monad (guard, )--import qualified Data.List       as List-import qualified Data.List.HT    as ListHT-import qualified Data.List.Match as ListMatch-import Data.Ord.HT (limit, )-import Data.Tuple.HT (mapPair, mapSnd, forcePair, )- import NumericPrelude.Numeric---- import qualified Prelude as P import NumericPrelude.Base
src/Synthesizer/Plain/Wave.hs view
@@ -14,7 +14,6 @@  import NumericPrelude.Numeric --- import qualified Prelude as P import NumericPrelude.Base
src/Synthesizer/State/Analysis.hs view
@@ -1,13 +1,38 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-module Synthesizer.State.Analysis where+module Synthesizer.State.Analysis (+   volumeMaximum,+   volumeEuclidean,+   volumeEuclideanSqr,+   volumeSum,+   volumeVectorMaximum,+   volumeVectorEuclidean,+   volumeVectorEuclideanSqr,+   volumeVectorSum,+   bounds,+   histogramDiscreteArray,+   histogramLinearArray,+   histogramDiscreteIntMap,+   histogramLinearIntMap,+   histogramIntMap,+   directCurrentOffset,+   scalarProduct,+   centroid,+   centroidRecompute,+   firstMoment,+   average,+   averageRecompute,+   rectify,+   zeros,+   flipFlopHysteresis,+   chirpTransform,+   ) where +import qualified Synthesizer.Plain.Analysis as Ana import qualified Synthesizer.State.Control as Ctrl import qualified Synthesizer.State.Signal  as Sig --- import qualified Algebra.Module                as Module--- import qualified Algebra.Transcendental        as Trans import qualified Algebra.Algebraic             as Algebraic import qualified Algebra.RealField             as RealField import qualified Algebra.Field                 as Field@@ -25,8 +50,8 @@  import Data.Array (accumArray) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Notions of volume -}@@ -256,23 +281,7 @@  {-# INLINE meanValues #-} meanValues :: RealField.C y => Sig.T y -> [(Int,y)]-meanValues x = concatMap spread (Sig.toList (Sig.mapAdjacent (,) x))--{-# INLINE spread #-}-spread :: RealField.C y => (y,y) -> [(Int,y)]-spread (l0,r0) =-   let (l,r) = if l0<=r0 then (l0,r0) else (r0,l0)-       (li,lf) = splitFraction l-       (ri,rf) = splitFraction r-       k = recip (r-l)-       nodes =-          (li,k*(1-lf)) :-          zip [li+1 ..] (replicate (ri-li-1) k) ++-          (ri, k*rf) :-          []-   in  if li==ri-         then [(li,one)]-         else nodes+meanValues = concatMap Ana.spread . Sig.toList . Sig.mapAdjacent (,)  {- | Requires finite length.@@ -347,13 +356,8 @@ -} {-# INLINE flipFlopHysteresis #-} flipFlopHysteresis :: (Ord y) =>-   (y,y) -> Bool -> Sig.T y -> Sig.T Bool-flipFlopHysteresis (lower,upper) =-   Sig.scanL-      (\state x ->-          if state-            then not(x<lower)-            else x>upper)+   (y,y) -> Ana.BinaryLevel -> Sig.T y -> Sig.T Ana.BinaryLevel+flipFlopHysteresis bnds = Sig.scanL (Ana.flipFlopHysteresisStep bnds)  {- | Almost naive implementation of the chirp transform,
src/Synthesizer/State/Control.hs view
@@ -9,25 +9,35 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.State.Control where+module Synthesizer.State.Control (+   constant,+   line,+   linear, linearMultiscale, linearMultiscaleNeutral,+   exponential, exponentialMultiscale, exponentialMultiscaleNeutral,+   exponential2, exponential2Multiscale, exponential2MultiscaleNeutral,+   exponentialFromTo, exponentialFromToMultiscale,+   vectorExponential,+   vectorExponential2,+   cosine,+   cubicHermite, +   -- used in Analysis+   curveMultiscale,+   curveMultiscaleNeutral,+   ) where+ import qualified Synthesizer.Plain.Control as Ctrl-import qualified Synthesizer.Piecewise as Piecewise-import Synthesizer.State.Displacement (raise)  import qualified Synthesizer.State.Signal as Sig  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.Ring                  as Ring import qualified Algebra.Additive              as Additive -import Data.Ix (Ix, )--import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- * Control curve generation -}@@ -181,94 +191,6 @@ cubicHermite :: Field.C a => (a, (a,a)) -> (a, (a,a)) -> Sig.T a cubicHermite node0 node1 =    Sig.map (Ctrl.cubicFunc node0 node1) (linear 1 0)------ * piecewise curves---splitDurations :: (RealRing.C t) =>-   [t] -> [(Int, t)]-splitDurations ts0 =-   let (ds,ts) =-           unzip $ scanl-              (\(_,fr) d -> splitFraction (fr+d))-              (0,1) ts0-   in  zip (tail ds) (map (subtract 1) ts)--{-# INLINE piecewise #-}-piecewise :: (RealRing.C a) =>-   Piecewise.T a a (a -> Sig.T a) -> Sig.T a-piecewise xs =-   Sig.concat $ zipWith-      (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->-           Sig.take n $ Piecewise.computePiece c yi0 yi1 d t)-      (splitDurations $ map Piecewise.pieceDur xs)-      xs---type Piece a =-   Piecewise.Piece a a-      (a {- fractional start time -} -> Sig.T a)---{-# INLINE stepPiece #-}-stepPiece :: Piece a-stepPiece =-   Piecewise.pieceFromFunction $ \ y0 _y1 _d _t0 ->-      constant y0--{-# INLINE linearPiece #-}-linearPiece :: (Field.C a) => Piece a-linearPiece =-   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->-      let s = (y1-y0)/d in linear s (y0-t0*s)--{-# INLINE exponentialPiece #-}-exponentialPiece :: (Trans.C a) => a -> Piece a-exponentialPiece saturation =-   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->-      let y0' = y0-saturation-          y1' = y1-saturation-          yd  = y0'/y1'-      in  raise saturation-             (exponential (d / log yd) (y0' * yd**(t0/d)))--{-# INLINE cosinePiece #-}-cosinePiece :: (Trans.C a) => Piece a-cosinePiece =-   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->-      Sig.map-         (\y -> ((1+y)*y0+(1-y)*y1)/2)-         (cosine t0 (t0+d))---data FlatPosition =-   FlatLeft | FlatRight-      deriving (Show, Eq, Ord, Ix, Enum)--{- |-> Graphics.Gnuplot.Simple.plotList [] $ Sig.toList $ piecewise $ 1 |# (10.9, halfSinePiece FlatRight) #| 2--}-{-# INLINE halfSinePiece #-}-halfSinePiece :: (Trans.C a) => FlatPosition -> Piece a-halfSinePiece FlatLeft =-   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->-      Sig.map-         (\y -> y*y0 + (1-y)*y1)-         (cosine t0 (t0+2*d))-halfSinePiece FlatRight =-   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->-      Sig.map-         (\y -> (1+y)*y0 - y*y1)-         (cosine (t0-d) (t0+d))---{-# INLINE cubicPiece #-}-cubicPiece :: (Field.C a) => a -> a -> Piece a-cubicPiece yd0 yd1 =-   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->-      cubicHermite (t0,(y0,yd0)) (t0+d,(y1,yd1))   -- * auxiliary functions
src/Synthesizer/State/Cut.hs view
@@ -34,20 +34,20 @@ import qualified Algebra.RealRing     as RealRing import qualified Algebra.Additive as Additive -import qualified Data.Array as Array-import Data.Array (Array, Ix, (!), ) import Control.Applicative (Applicative, )-import Data.Traversable (sequenceA, )  import qualified Data.List.HT as ListHT+import qualified Data.Array as Array+import Data.Traversable (sequenceA, ) import Data.Tuple.HT (mapFst, mapSnd, )+import Data.Array (Array, Ix, (!), ) import Data.Maybe (fromMaybe, )  import qualified Synthesizer.ChunkySize as ChunkySize import qualified Number.NonNegative as NonNegW -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/State/Displacement.hs view
@@ -7,8 +7,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   -- * Mixing
src/Synthesizer/State/Filter/Delay.hs view
@@ -1,5 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.State.Filter.Delay where+module Synthesizer.State.Filter.Delay (+   static,+   staticPad,+   staticPos,+   staticNeg,+   modulated,+   ) where  import qualified Synthesizer.Interpolation as Interpolation import qualified Synthesizer.State.Interpolation as InterpolationS@@ -8,8 +14,6 @@ import qualified Algebra.RealField as RealField import qualified Algebra.Additive  as Additive --- import qualified Prelude as P--- import NumericPrelude.Base import NumericPrelude.Numeric
src/Synthesizer/State/Filter/NonRecursive.hs view
@@ -7,8 +7,25 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.State.Filter.NonRecursive where+module Synthesizer.State.Filter.NonRecursive (+   amplify,+   amplifyVector,+   envelope,+   envelopeVector,+   fadeInOut,+   generic,+   binomial,+   binomial1,+   sums,+   inverseFrequencyModulationFloor,+   inverseFrequencyModulationCeiling,+   differentiate,+   differentiateCenter,+   differentiate2,+   ) where +import Synthesizer.Basic.Filter.NonRecursive (ratioFreqToVariance, )+ import qualified Synthesizer.State.Signal as Sig  import qualified Synthesizer.State.Filter.Delay as Delay@@ -24,8 +41,8 @@ import Data.Function.HT (nest, ) import Data.Tuple.HT (mapFst, ) -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   @@ -124,30 +141,6 @@ binomial ratio freq =    let width = ceiling (2 * ratioFreqToVariance ratio freq ^ 2)    in  Sig.drop width . nest (2*width) ((asTypeOf 0.5 freq *>) . binomial1)--{--exp (-(t/var)^2/2) / area *> cis (2*pi*f*t)-  == exp (-(t/var)^2/2 +: 2*pi*f*t) / area-  == exp ((-t^2 +: 2*var^2*2*pi*f*t) / (2*var^2)) / area-  == exp ((t^2 - i*2*var^2*2*pi*f*t) / (-2*var^2)) / area-  == exp (((t^2 - i*var^2*2*pi*f)^2 + (var^2*2*pi*f)^2) / (-2*var^2)) / area-  == exp (((t^2 - i*var^2*2*pi*f)^2 / (-2*var^2) - (var*2*pi*f)^2/2)) / area--sumMap (\t -> exp (-(t/var)^2/2) / area *> cis (2*pi*f*t))-       [-infinity..infinity]-  ~ sumMap (\t -> exp (-(t/var)^2/2)) [-infinity..infinity]-       * exp (-(var*2*pi*f)^2/2) / area-  = exp (-(var*2*pi*f)^2/2)--}-{- |-  Compute the variance of the Gaussian-  such that its Fourier transform has value @ratio@ at frequency @freq@.--}-{-# INLINE ratioFreqToVariance #-}-ratioFreqToVariance :: (Trans.C a) => a -> a -> a-ratioFreqToVariance ratio freq =-   sqrt (-2 * log ratio) / (2*pi*freq)-           -- inverse of the fourier transformed gaussian  {-# INLINE binomial1 #-} binomial1 :: (Additive.C v) => Sig.T v -> Sig.T v
src/Synthesizer/State/Filter/Recursive/Comb.hs view
@@ -23,8 +23,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {- |
src/Synthesizer/State/Filter/Recursive/Integration.hs view
@@ -14,12 +14,10 @@ import qualified Synthesizer.State.Signal  as Sig import qualified Synthesizer.Causal.Process as Causal --- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/State/Filter/Recursive/MovingAverage.hs view
@@ -8,10 +8,10 @@ Portability :  requires multi-parameter type classes  -}-module Synthesizer.State.Filter.Recursive.MovingAverage-   (sumsStaticInt,-    modulatedFrac,-    ) where+module Synthesizer.State.Filter.Recursive.MovingAverage (+   sumsStaticInt,+   modulatedFrac,+   ) where  import qualified Synthesizer.State.Signal  as Sig import qualified Synthesizer.State.Filter.Recursive.Integration as Integration@@ -20,13 +20,10 @@  import qualified Algebra.Module                as Module import qualified Algebra.RealField             as RealField---- import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base
src/Synthesizer/State/Interpolation.hs view
@@ -1,17 +1,27 @@ {-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.State.Interpolation where+module Synthesizer.State.Interpolation (+   zeroPad,+   constantPad,+   cyclicPad,+   extrapolationPad, -import Synthesizer.Interpolation-   (T, offset, number, func, )+   skip,+   single, -import qualified Synthesizer.State.Signal  as Sig+   -- imported in State.Filter.Delay+   delayPad,+   ) where -import qualified Algebra.RealRing  as RealRing+import Synthesizer.Interpolation (T, offset, number, func, ) +import qualified Synthesizer.State.Signal  as Sig+ import Data.Maybe (fromMaybe) -import NumericPrelude.Base+import qualified Algebra.RealRing  as RealRing+ import NumericPrelude.Numeric+import NumericPrelude.Base   {-* Interpolation with various padding methods -}
src/Synthesizer/State/Noise.hs view
@@ -4,14 +4,14 @@  import qualified Synthesizer.State.Signal as Sig -import qualified Algebra.RealRing                  as RealRing+import qualified Algebra.RealRing              as RealRing import qualified Algebra.Ring                  as Ring  import System.Random (Random, RandomGen, randomR, mkStdGen, ) import qualified System.Random as Rnd -import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base   {-|
src/Synthesizer/State/NoiseCustom.hs view
@@ -8,16 +8,15 @@  import qualified Synthesizer.State.Signal as Sig -import qualified Algebra.RealField             as RealField-import qualified Algebra.Field                 as Field- import qualified Synthesizer.RandomKnuth as Knuth--import System.Random (Random, RandomGen, ) import qualified System.Random as Rnd+import System.Random (Random, RandomGen, ) -import NumericPrelude.Base+import qualified Algebra.RealField             as RealField+import qualified Algebra.Field                 as Field+ import NumericPrelude.Numeric+import NumericPrelude.Base   {-|
src/Synthesizer/State/Oscillator.hs view
@@ -13,25 +13,21 @@  import qualified Synthesizer.Causal.Oscillator  as Osci import qualified Synthesizer.Causal.Oscillator.Core as OsciCore+import qualified Synthesizer.Causal.Process as Causal+ import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth import qualified Synthesizer.Basic.Wave         as Wave import qualified Synthesizer.Basic.Phase        as Phase -import qualified Synthesizer.Causal.Process as Causal import qualified Synthesizer.State.Signal as Sig- import qualified Synthesizer.Generic.Signal as SigG- import qualified Synthesizer.Interpolation as Interpolation - import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField import qualified Algebra.RealRing              as RealRing --- import qualified Prelude as P import NumericPrelude.Numeric (Float, Double, )--- import NumericPrelude.Base
+ src/Synthesizer/State/Piece.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |+See "Synthesizer.Generic.Piece".+-}+module Synthesizer.State.Piece (+   T, run,+   step, linear, exponential,+   cosine, halfSine, cubic,+   FlatPosition(..),+   ) where++import qualified Synthesizer.Piecewise as Piecewise+import Synthesizer.Piecewise (FlatPosition (FlatLeft, FlatRight))++import qualified Synthesizer.State.Control as Ctrl+import qualified Synthesizer.State.Signal as Sig+import Synthesizer.State.Displacement (raise)++import qualified Algebra.Transcendental        as Trans+import qualified Algebra.RealRing              as RealRing+import qualified Algebra.Field                 as Field++import NumericPrelude.Numeric+import NumericPrelude.Base++++{-# INLINE run #-}+run :: (RealRing.C a) => Piecewise.T a a (a -> Sig.T a) -> Sig.T a+run xs =+   Sig.concat $ zipWith+      (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->+           Sig.take n $ Piecewise.computePiece c yi0 yi1 d t)+      (Piecewise.splitDurations $ map Piecewise.pieceDur xs)+      xs+++type T a = Piecewise.Piece a a (a {- fractional start time -} -> Sig.T a)+++{-# INLINE step #-}+step :: T a+step =+   Piecewise.pieceFromFunction $ \ y0 _y1 _d _t0 ->+      Ctrl.constant y0++{-# INLINE linear #-}+linear :: (Field.C a) => T a+linear =+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      let s = (y1-y0)/d in Ctrl.linear s (y0-t0*s)++{-# INLINE exponential #-}+exponential :: (Trans.C a) => a -> T a+exponential saturation =+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      let y0' = y0-saturation+          y1' = y1-saturation+          yd  = y0'/y1'+      in  raise saturation+             (Ctrl.exponential (d / log yd) (y0' * yd**(t0/d)))++{-# INLINE cosine #-}+cosine :: (Trans.C a) => T a+cosine =+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      Sig.map+         (\y -> ((1+y)*y0+(1-y)*y1)/2)+         (Ctrl.cosine t0 (t0+d))+++{- |+> Graphics.Gnuplot.Simple.plotList [] $ Sig.toList $ Piece.run $ 1 |# (10.9, Piece.halfSine FlatRight) #| 2+-}+{-# INLINE halfSine #-}+halfSine :: (Trans.C a) => FlatPosition -> T a+halfSine FlatLeft =+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      Sig.map+         (\y -> y*y0 + (1-y)*y1)+         (Ctrl.cosine t0 (t0+2*d))+halfSine FlatRight =+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      Sig.map+         (\y -> (1+y)*y0 - y*y1)+         (Ctrl.cosine (t0-d) (t0+d))+++{-# INLINE cubic #-}+cubic :: (Field.C a) => a -> a -> T a+cubic yd0 yd1 =+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      Ctrl.cubicHermite (t0,(y0,yd0)) (t0+d,(y1,yd1))
src/Synthesizer/State/Signal.hs view
@@ -10,15 +10,13 @@ -} module Synthesizer.State.Signal where --- import qualified Synthesizer.Plain.Signal   as Sig import qualified Synthesizer.Plain.Modifier as Modifier import qualified Data.List as List  import qualified Algebra.Module   as Module import qualified Algebra.Additive as Additive-import Algebra.Additive (zero)- import Algebra.Module ((*>))+import Algebra.Additive (zero)  import qualified Synthesizer.Format as Format
src/Synthesizer/State/ToneModulation.hs view
@@ -1,5 +1,23 @@-module Synthesizer.State.ToneModulation where+module Synthesizer.State.ToneModulation (+   Cell,+   makeCell,+   interpolateCell, +   Prototype,+   makePrototype,+   sampledToneCell,++   oscillatorCells,++   -- needed in Causal.ToneModulation+   checkNonNeg,++   -- for testing+   oscillatorCoords,+   limitRelativeShapes,+   limitMinRelativeValues,+   ) where+ import qualified Synthesizer.Basic.ToneModulation as ToneMod import qualified Synthesizer.Causal.Oscillator.Core as Osci @@ -12,17 +30,12 @@  import qualified Synthesizer.Basic.Phase as Phase --- import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField--- import qualified Algebra.Field                 as Field--- import qualified Algebra.RealRing                  as RealRing--- import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive  import Data.Ord.HT (limit, )  import NumericPrelude.Numeric--- import qualified Prelude as P import NumericPrelude.Base import Prelude ()
src/Synthesizer/Storable/Cut.hs view
@@ -1,24 +1,33 @@-module Synthesizer.Storable.Cut where+module Synthesizer.Storable.Cut (+   arrange, +   -- for MIDI.CausalIO.Process+   addChunkToBuffer,++   -- for testing+   arrangeEquidist,+   arrangeAdaptive,+   arrangeList,+   ) where+ import qualified Synthesizer.Storable.Signal as Sig  import qualified Data.StorableVector           as SV import qualified Data.StorableVector.Lazy      as SVL import qualified Data.StorableVector.ST.Strict as SVST+import Foreign.Storable (Storable)  import Control.Monad.ST.Strict (ST, runST, )+import Control.Monad.Trans.State (runState, modify, gets, put, )  import qualified Data.EventList.Relative.TimeBody  as EventList import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Data.EventList.Absolute.TimeBody  as AbsEventList-import Control.Monad.Trans.State (runState, modify, gets, put, ) import Data.Tuple.HT (mapSnd, )  import qualified Algebra.Additive as Additive import qualified Number.NonNegative as NonNeg -import Foreign.Storable (Storable)- import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()@@ -211,10 +220,10 @@    in  go start 0  {- | chunk must fit into the buffer -}-{-# INLINE unsafeAddChunkToBufferFoldr #-}-unsafeAddChunkToBufferFoldr :: (Storable a, Additive.C a) =>+{-# INLINE _unsafeAddChunkToBufferFoldr #-}+_unsafeAddChunkToBufferFoldr :: (Storable a, Additive.C a) =>    SVST.Vector s a -> Int -> SV.Vector a -> ST s ()-unsafeAddChunkToBufferFoldr v start xs =+_unsafeAddChunkToBufferFoldr v start xs =    SV.foldr       (\x continue i ->          SVST.unsafeModify v i (x +) >>@@ -224,10 +233,10 @@   -- most elegant solution, but slow because StorableVector.foldr is slow-{-# INLINE addToBufferFoldr #-}-addToBufferFoldr :: (Storable a, Additive.C a) =>+{-# INLINE _addToBufferFoldr #-}+_addToBufferFoldr :: (Storable a, Additive.C a) =>    SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)-addToBufferFoldr v start xs =+_addToBufferFoldr v start xs =    let n = SVST.length v        (now,future) = Sig.splitAt (n Additive.- start) xs    in  Sig.foldr@@ -244,9 +253,9 @@ Using a StorableVectorPointer would be faster, but I think still slower than @foldr@. -}-addToBufferSwitchL :: (Storable a, Additive.C a) =>+_addToBufferSwitchL :: (Storable a, Additive.C a) =>    SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)-addToBufferSwitchL v start =+_addToBufferSwitchL v start =    let n = SVST.length v        {-# INLINE go #-}        go i =
src/Synthesizer/Storable/Filter/NonRecursive.hs view
@@ -8,16 +8,30 @@ Stability   :  provisional Portability :  requires multi-parameter type classes -}-module Synthesizer.Storable.Filter.NonRecursive where+module Synthesizer.Storable.Filter.NonRecursive (+   downsample2,+   sumsDownsample2,+   convolveDownsample2,+   inverseFrequencyModulationFloor,+   sumsPosModulatedPyramid,+   accumulatePosModulatedPyramid,+   accumulateBinPosModulatedPyramid,+   movingAverageModulatedPyramid,+   movingAccumulateModulatedPyramid, +   -- for testing+   sumsDownsample2Alt,+   pyramid,+   ) where+ import qualified Synthesizer.Storable.Signal as SigSt import qualified Data.StorableVector as V import qualified Data.StorableVector.Pointer as VPtr import qualified Data.StorableVector.Lazy as VL import qualified Data.StorableVector.Lazy.Pattern as VP +import qualified Synthesizer.Basic.Filter.NonRecursive as Filt import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG-import qualified Synthesizer.Plain.Filter.NonRecursive as Filt import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Plain.Signal as Sig@@ -31,16 +45,16 @@ import Foreign.Storable.Tuple ()  import Control.Monad (mplus, )-import Data.Maybe.HT (toMaybe, )-import Data.Maybe (fromMaybe, )  import qualified Data.List as List import Data.Tuple.HT (mapFst, mapSnd, mapPair, swap, )+import Data.Maybe.HT (toMaybe, )+import Data.Maybe (fromMaybe, )  import qualified Numeric.NonNegative.Chunky as NonNegChunky -import NumericPrelude.Base-import NumericPrelude.Numeric as NP+import NumericPrelude.Numeric+import NumericPrelude.Base as NP   {- |@@ -186,11 +200,8 @@    SigSt.T (Int,Int) -> SigSt.T v accumulatePosModulatedPyramid accumulate (sizes,pyr0) ctrl =    let blockSize = head sizes-       pyrStarts =-          iterate (zipWith SigSt.drop sizes) pyr0-       ctrlBlocks =-          SigS.toList $-          SigG.sliceVertical blockSize ctrl+       pyrStarts = iterate (zipWith SigSt.drop sizes) pyr0+       ctrlBlocks = SigS.toList $ SigG.sliceVertical blockSize ctrl    in  SigSt.fromChunks $        zipWith           (\pyr ->@@ -206,9 +217,7 @@ sumsPosModulatedPyramid height ctrl xs =    FiltG.accumulatePosModulatedFromPyramid       FiltG.sumRangeFromPyramid-      (let pyr0 = pyramid (+) height xs-           sizes = Filt.unitSizesFromPyramid pyr0-       in  (sizes, pyr0))+      (addSizes $ pyramid (+) height xs)       ctrl  accumulateBinPosModulatedPyramid ::@@ -220,12 +229,13 @@       (\pyr ->          fromMaybe (error "accumulateBinPosModulatedPyramid: empty window") .          FiltG.maybeAccumulateRangeFromPyramid acc pyr)-      (let pyr0 = pyramid acc height xs-           sizes = Filt.unitSizesFromPyramid pyr0-       in  (sizes, pyr0))+      (addSizes $ pyramid acc height xs)       ctrl +addSizes :: [signal] -> ([Int], [signal])+addSizes pyr = (Filt.unitSizesFromPyramid pyr, pyr) + {- | The first argument is the amplification. The main reason to introduce it,@@ -233,8 +243,7 @@ This way we can also filter stereo signals. -} movingAverageModulatedPyramid ::-   (Field.C a, Module.C a v,-    Storable Int, Storable v) =>+   (Field.C a, Module.C a v, Storable Int, Storable v) =>    a -> Int -> Int -> SigSt.T Int -> SigSt.T v -> SigSt.T v movingAverageModulatedPyramid amp height maxC ctrl xs =    SigSt.zipWith (\c x -> (amp / fromIntegral (2*c+1)) *> x) ctrl $@@ -293,8 +302,9 @@    let {-# INLINE switch #-}        {-        switch ::-          (Maybe s -> r) ->-          ((t,v) -> (s, VPtr.Pointer v) -> r) ->+          (Maybe (t, s) -> r) ->+          ((t, v) -> (s, VPtr.Pointer v) -> r) ->+          t ->           (s, VPtr.Pointer v) -> r        -}        {-@@ -315,7 +325,7 @@        {-        go ::           (t,v) -> (s, VPtr.Pointer v) ->-          Either (Maybe s) (v, ((t,v), (s, VPtr.Pointer v)))+          Either (Maybe (t,s)) (v, ((t,v), (s, VPtr.Pointer v)))        -}        go (c,x) cxp =           if c<1
src/Synthesizer/Storable/Oscillator.hs view
@@ -18,15 +18,6 @@ import Synthesizer.Storable.Signal (ChunkSize) import Foreign.Storable (Storable) --- import qualified Synthesizer.Plain.Interpolation as Interpolation--{--import qualified Algebra.RealTranscendental    as RealTrans-import qualified Algebra.Module                as Module-import qualified Algebra.VectorSpace           as VectorSpace--import Algebra.Module((*>))--} import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealRing              as RealRing
src/Synthesizer/Storable/Play.hs view
@@ -11,12 +11,12 @@ import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.Frame.Stereo as Stereo -import qualified Algebra.RealRing as RealRing- import System.Exit (ExitCode, ) -import NumericPrelude.Base+import qualified Algebra.RealRing as RealRing+ import NumericPrelude.Numeric+import NumericPrelude.Base   {- |
src/Synthesizer/Storable/Signal.hs view
@@ -8,58 +8,58 @@    instead of calling a function in an inner loop. -} module Synthesizer.Storable.Signal (-      T,-      Vector.hPut,-      ChunkSize, Vector.chunkSize, defaultChunkSize,-      -- for Storable.Oscillator-      scanL,-      Vector.map,-      Vector.iterate,-      Vector.zipWith,-      -- for State.Signal-      Vector.append,-      Vector.concat,-      Vector.span,-      Vector.splitAt,-      Vector.viewL,-      Vector.viewR,-      Vector.switchL,-      Vector.unfoldr,-      Vector.reverse,-      Vector.crochetL,-      -- for Dimensional.File-      Vector.writeFile,-      -- for Storable.Cut-      mix, mixSndPattern, mixSize,-      splitAtPad,-      Vector.null,-      Vector.fromChunks,-      Vector.foldr,-      -- for Storable.Filter.Comb-      delay,-      delayLoop,-      delayLoopOverlap,-      -- for FusionList.Storable-      Vector.empty,-      Vector.cons,-      Vector.replicate,-      Vector.repeat,-      Vector.drop,-      Vector.take,-      takeCrochet,-      fromList,-      -- for Generic.Signal-      zipWithRest,-      zipWithAppend,-      -- for Storable.ALSA.MIDI-      Vector.switchR,-      -- for Test.Filter-      toList,-      -- for Storable.Filter.NonRecursive-      Vector.chunks,+   T,+   Vector.hPut,+   ChunkSize, Vector.chunkSize, defaultChunkSize,+   -- for Storable.Oscillator+   scanL,+   Vector.map,+   Vector.iterate,+   Vector.zipWith,+   -- for State.Signal+   Vector.append,+   Vector.concat,+   Vector.span,+   Vector.splitAt,+   Vector.viewL,+   Vector.viewR,+   Vector.switchL,+   Vector.unfoldr,+   Vector.reverse,+   Vector.crochetL,+   -- for Dimensional.File+   Vector.writeFile,+   -- for Storable.Cut+   mix, mixSndPattern, mixSize,+   splitAtPad,+   Vector.null,+   Vector.fromChunks,+   Vector.foldr,+   -- for Storable.Filter.Comb+   delay,+   delayLoop,+   delayLoopOverlap,+   -- for FusionList.Storable+   Vector.empty,+   Vector.cons,+   Vector.replicate,+   Vector.repeat,+   Vector.drop,+   Vector.take,+   takeCrochet,+   fromList,+   -- for Generic.Signal+   zipWithRest,+   zipWithAppend,+   -- for Storable.ALSA.MIDI+   Vector.switchR,+   -- for Test.Filter+   toList,+   -- for Storable.Filter.NonRecursive+   Vector.chunks, -      -- just for fun-      genericLength,+   -- just for fun+   genericLength,    ) where  import qualified Data.List as List@@ -68,17 +68,14 @@ import qualified Data.StorableVector as V import Data.StorableVector.Lazy (ChunkSize(..)) --- import Data.Maybe (Maybe(Just,Nothing), maybe, fromMaybe)---- import Data.StorableVector(Vector) import Foreign.Storable (Storable, ) import Foreign.Storable.Tuple ()  import qualified Synthesizer.Frame.Stereo as Stereo--- import qualified Synthesizer.Format as Format --- import Control.Arrow ((***))--- import Control.Monad (liftM, liftM2, {- guard, -} )+import qualified Data.List.HT as ListHT+import Data.Maybe.HT (toMaybe, )+import Data.Tuple.HT (mapFst, mapSnd, mapPair, forcePair, )  import qualified Algebra.Ring      as Ring import qualified Algebra.Additive  as Additive@@ -86,16 +83,6 @@  import qualified Number.NonNegativeChunky as Chunky import qualified Number.NonNegative       as NonNeg--import qualified Data.List.HT as ListHT-import Data.Maybe.HT (toMaybe, )-import Data.Tuple.HT (mapFst, mapSnd, mapPair, forcePair, )---- import qualified Algebra.Additive as Additive----- import System.IO (openBinaryFile, hClose, hPutBuf, IOMode(WriteMode), Handle)-  import NumericPrelude.Numeric import NumericPrelude.Base
src/Synthesizer/Utility.hs view
@@ -7,9 +7,9 @@  import System.Random (Random, RandomGen, randomRs, ) -import Prelude ()-import NumericPrelude.Base import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude ()   {-|
src/Synthesizer/Zip.hs view
@@ -2,10 +2,10 @@  import qualified Synthesizer.Generic.Cut as CutG -import Data.Monoid (Monoid, mempty, mappend, )- import qualified Control.Arrow as Arrow import Control.Arrow (Arrow, (<<<), (^<<), (<<^), )++import Data.Monoid (Monoid, mempty, mappend, )   {- |
synthesizer-core.cabal view
@@ -1,5 +1,5 @@ Name:           synthesizer-core-Version:        0.7.1+Version:        0.8 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -37,7 +37,7 @@   Source-Repository this-  Tag:         0.7.1+  Tag:         0.8   Type:        darcs   Location:    http://code.haskell.org/synthesizer/core/ @@ -49,16 +49,15 @@   Build-Depends:     sample-frame-np >=0.0.4 && <0.1,     sox >=0.1 && <0.3,-    transformers >=0.2 && <0.5,-    non-empty >=0.2 && <0.3,+    transformers >=0.2 && <0.6,+    non-empty >=0.2 && <0.4,     event-list >=0.1 && <0.2,     non-negative >=0.1 && <0.2,     explicit-exception >=0.1.6 && <0.2,-    numeric-prelude >=0.4 && <0.5,+    numeric-prelude >=0.4.2 && <0.5,     numeric-quest >=0.1 && <0.3,-    utility-ht >=0.0.5 && <0.1,+    utility-ht >=0.0.12 && <0.1,     filepath >=1.1 && <1.5,-    stream-fusion >=0.1.2 && <0.2,     bytestring >=0.9 && <0.11,     binary >=0.1 && <1,     deepseq >=1.1 && <1.5,@@ -69,7 +68,7 @@     array >=0.1 && <0.6,     containers >=0.1 && <0.6,     random >=1.0 && <2.0,-    process >=1.0 && <1.3,+    process >=1.0 && <1.5,     base >= 4 && <5    If impl(ghc>=7.0)@@ -167,6 +166,7 @@     Synthesizer.State.Noise     Synthesizer.State.NoiseCustom     Synthesizer.State.Oscillator+    Synthesizer.State.Piece     Synthesizer.State.Signal     Synthesizer.State.ToneModulation     Synthesizer.Causal.Process@@ -214,6 +214,7 @@     Synthesizer.Utility    Other-Modules:+    Synthesizer.Basic.Filter.NonRecursive     Synthesizer.Basic.ComplexModule     Synthesizer.Basic.NumberTheory     Synthesizer.Generic.Permutation@@ -227,7 +228,7 @@     storablevector,     storable-tuple,     event-list,-    non-empty >=0.2.1 && <0.3,+    non-empty >=0.2.1 && <0.4,     non-negative,     utility-ht,     numeric-prelude,
test/Test/Sound/Synthesizer/Basic/NumberTheory.hs view
@@ -3,6 +3,9 @@  import Synthesizer.Basic.NumberTheory (Order(Order), ) import qualified Synthesizer.Basic.NumberTheory as NT++import Control.Applicative ((<$>), )+ import qualified Data.Set as Set import qualified Data.Bits as Bit @@ -35,11 +38,7 @@    deriving (Show)  instance Arbitrary Prime where-   arbitrary = do-      n <- fmap ((2+) . flip mod 10000) arbitrary-      if NT.isPrime n-        then return $ Prime n-        else arbitrary+   arbitrary = fmap Prime $ QC.suchThat (QC.choose (2,10000)) NT.isPrime   newtype Big = Big Integer@@ -115,9 +114,8 @@              &&              NT.hasPrimitiveRootOfUnityInteger r n) :    ("combine many rings with primitive roots of certain orders",-      quickCheck $ \n0 ns0 ->-         let ns = take 3 $ map (\n -> 1 + mod n 10) (n0:ns0)-             order = NT.lcmMulti ns+      quickCheck $ QC.forAll (take 3 <$> QC.listOf1 (QC.choose (1,10))) $ \ns ->+         let order = NT.lcmMulti ns          in  take 3 (NT.ringsWithPrimitiveRootsOfUnityAndUnitsNaive                        (map Order ns) ns)              ==@@ -165,14 +163,14 @@    ("ceiling5Smooth vs. is5Smooth",       quickCheck $ \(Positive n) -> NT.is5Smooth $ NT.ceiling5Smooth n) :    ("ceiling3Smooth vs. numbers3Smooth",-      simple $ \(Positive k) ->-         let (n0:n1:_) = drop (fromInteger $ mod k 500) NT.numbers3Smooth+      quickCheck $ QC.forAll (QC.choose (0,500)) $ \k ->+         let (n0:n1:_) = drop k NT.numbers3Smooth          in  NT.ceiling3Smooth n0 == n0              &&              NT.ceiling3Smooth (n0+1) == n1) :    ("ceiling5Smooth vs. numbers5Smooth",-      simple $ \(Positive k) ->-         let (n0:n1:_) = drop (fromInteger $ mod k 500) NT.numbers5Smooth+      quickCheck $ QC.forAll (QC.choose (0,500)) $ \k ->+         let (n0:n1:_) = drop k NT.numbers5Smooth          in  NT.ceiling5Smooth n0 == n0              &&              NT.ceiling5Smooth (n0+1) == n1) :
test/Test/Sound/Synthesizer/Basic/ToneModulation.hs view
@@ -9,7 +9,6 @@ import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest  import Test.QuickCheck (quickCheck, Property, (==>), Testable, )--- import Test.Utility  import qualified Number.NonNegative       as NonNeg
test/Test/Sound/Synthesizer/Causal/Analysis.hs view
@@ -11,6 +11,7 @@ import qualified Data.List.Match as Match import qualified Data.List as List +import qualified Test.QuickCheck as QC import Test.QuickCheck (quickCheck, )  import NumericPrelude.Numeric@@ -40,9 +41,9 @@             (AnaC.deltaSigmaModulationPositive <<<              Causal.feedConstFst threshold) (xs::[Rational])) :    ("movingMedian",-      quickCheck $ \n0 xs ->-         let n = mod n0 20 + 1-         in  movingMedian n xs-             ==-             Causal.apply (AnaC.movingMedian n) (xs::[Char])) :+      quickCheck $+      QC.forAll (QC.choose (1,20)) $ \n xs ->+         movingMedian n xs+         ==+         Causal.apply (AnaC.movingMedian n) (xs::[Char])) :    []
test/Test/Sound/Synthesizer/Generic/Filter.hs view
@@ -11,8 +11,6 @@  import Test.QuickCheck (Testable, quickCheck, ) --- import qualified Algebra.Ring                  as Ring- import qualified Algebra.Laws                  as Law  import NumericPrelude.Numeric
test/Test/Sound/Synthesizer/Generic/FourierInteger.hs view
@@ -71,13 +71,6 @@       (SigG.toState xs)       (SigG.toState ys) -{--signal ::-   Integral.C a =>-   Modulus a -> Sig.T a -> Sig.T (RC.T a)-signal (Modulus a) = fmap (/: a)--}- signal ::    Sig.T Integer -> (Modulus Integer, Sig.T (RC.T Integer)) signal xs =
test/Test/Sound/Synthesizer/Generic/Permutation.hs view
@@ -7,6 +7,7 @@  import qualified Synthesizer.Generic.Permutation as Permutation +import qualified Test.QuickCheck as QC import Test.QuickCheck (quickCheck, )  import NumericPrelude.Numeric@@ -14,29 +15,33 @@ import Prelude ()  +genRelPrime :: QC.Gen (Int, Int)+genRelPrime = do+   (n0,m0) <- QC.arbitrary+   let g = gcd n0 m0+   return $ if g==0 then (0,0) else (abs (div n0 g), abs (div m0 g))+ tests :: [(String, IO ())] tests =    ("inverse transposition",-      quickCheck $ \n0 m0 ->-         let n = mod n0 100-             m = mod m0 100-         in  Permutation.inverse (Permutation.transposition n m)-             ==-             Permutation.transposition m n) :+      quickCheck $+      QC.forAll (QC.choose (0,100)) $ \n ->+      QC.forAll (QC.choose (0,100)) $ \m ->+         Permutation.inverse (Permutation.transposition n m)+         ==+         Permutation.transposition m n) :    ("inverse skewGrid",-      quickCheck $ \n0 m0 ->-         let g = gcd n0 m0-             (n,m) = if g==0 then (0,0) else (abs (div n0 g), abs (div m0 g))-         in  Permutation.inverse (Permutation.skewGrid n m)-             ==-             Permutation.skewGridInv n m) :+      quickCheck $+      QC.forAll genRelPrime $ \(n,m) ->+         Permutation.inverse (Permutation.skewGrid n m)+         ==+         Permutation.skewGridInv n m) :    ("inverse skewGridCRT",-      quickCheck $ \n0 m0 ->-         let g = gcd n0 m0-             (n,m) = if g==0 then (0,0) else (abs (div n0 g), abs (div m0 g))-         in  Permutation.inverse (Permutation.skewGridCRT n m)-             ==-             Permutation.skewGridCRTInv n m) :+      quickCheck $+      QC.forAll genRelPrime $ \(n,m) ->+         Permutation.inverse (Permutation.skewGridCRT n m)+         ==+         Permutation.skewGridCRTInv n m) :    {-    reverse (multiplicative (generator n) n)    ==
test/Test/Sound/Synthesizer/Generic/ToneModulation.hs view
@@ -31,16 +31,15 @@  import Test.QuickCheck (quickCheck, Property, (==>), ) import Test.Utility (ArbChar, )--- import Debug.Trace (trace, )  import qualified Number.NonNegative       as NonNeg  import qualified Algebra.RealField             as RealField  +import qualified Data.List as List import Data.List.HT (viewL, takeWhileJust, ) import Data.Tuple.HT (mapSnd, )-import qualified Data.List as List   import NumericPrelude.Numeric
test/Test/Sound/Synthesizer/Plain/Analysis.hs view
@@ -16,6 +16,7 @@ import qualified Data.NonEmpty as NonEmpty import Data.List (genericLength) +import qualified Test.QuickCheck as QC import Test.QuickCheck (quickCheck, Property, (==>)) import Test.Utility (approxEqual) @@ -137,10 +138,15 @@           (Analysis.directCurrentOffset (map fromIntegral x) :: Rational)  -small :: (Functor f) => f Int -> f Int-small = fmap (flip mod 1000)+genSmall :: (Functor f, QC.Arbitrary (f Int)) => QC.Gen (f Int)+genSmall = fmap (fmap (flip mod 1000)) QC.arbitrary +forAllSmall ::+   (Functor f, QC.Arbitrary (f Int), Show (f Int), QC.Testable prop) =>+   (f Int -> prop) -> Property+forAllSmall = QC.forAll genSmall + tests :: [(String, IO ())] tests =    ("volumeVectorMaximum", quickCheck (volumeVectorMaximum :: [Rational] -> Bool)) :@@ -150,11 +156,13 @@    ("volumeVectorSum", quickCheck (volumeVectorSum :: NonEmpty.T [] Rational -> Bool)) :    ("bounds", quickCheck (bounds :: NonEmpty.T [] Rational -> Bool)) :    ("spread", quickCheck (spread :: (Rational,Rational) -> Bool)) :-   ("histogramDiscrete", quickCheck (histogramDiscrete . small)) :-   ("histogramDiscreteLength", quickCheck (histogramDiscreteLength . small)) :-   ("histogramDiscreteConcat", quickCheck (\x y -> histogramDiscreteConcat (small x) (small y))) :-   ("histogramLinear", quickCheck (histogramLinear . small)) :-   ("histogramLinearLength", quickCheck (histogramLinearLength . small)) :+   ("histogramDiscrete", quickCheck (forAllSmall histogramDiscrete)) :+   ("histogramDiscreteLength", quickCheck (forAllSmall histogramDiscreteLength)) :+   ("histogramDiscreteConcat",+      quickCheck $ forAllSmall $ \x -> forAllSmall $ \y ->+         histogramDiscreteConcat x y) :+   ("histogramLinear", quickCheck (forAllSmall histogramLinear)) :+   ("histogramLinearLength", quickCheck (forAllSmall histogramLinearLength)) :    ("centroid", quickCheck (centroid :: [Rational] -> Property)) :-   ("histogramDCOffset", quickCheck (histogramDCOffset . small)) :+   ("histogramDCOffset", quickCheck (forAllSmall histogramDCOffset)) :    []
test/Test/Sound/Synthesizer/Plain/Control.hs view
@@ -5,9 +5,6 @@ import Test.QuickCheck (quickCheck, Property, (==>)) import Test.Utility (equalList, approxEqualListAbs, approxEqualListRel, ) --- import qualified Algebra.Ring                  as Ring--- import qualified Algebra.Additive              as Additive- import Data.List (transpose)  import NumericPrelude.Numeric
test/Test/Sound/Synthesizer/Plain/Filter.hs view
@@ -17,34 +17,31 @@  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty -import Test.QuickCheck (quickCheck, {- Property, (==>) -})+import qualified Test.QuickCheck as QC+import Test.QuickCheck (Property, arbitrary, quickCheck, ) import Test.Utility (equalList, ArbChar, ) --- import qualified Algebra.Module                as Module--- import qualified Algebra.RealField             as RealField--- import qualified Algebra.Ring                  as Ring--- import qualified Algebra.Additive              as Additive- import qualified Number.GaloisField2p32m5 as GF import qualified Number.NonNegative       as NonNeg  import qualified Numeric.NonNegative.Chunky as Chunky -import qualified Data.List as List-import Data.Tuple.HT (mapPair, )+import Control.Applicative (liftA2, (<$>), ) --- import Debug.Trace (trace, )+import qualified Data.List as List+import Data.Tuple.HT (sortPair, mapPair, )+import Data.Ix (inRange, )  import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()  -sums :: NonNeg.Int -> Rational -> Sig.T Rational -> Bool-sums nn x0 xs0 =-   let n = min (length xs) (1 + NonNeg.toNumber nn)-       xs = x0:xs0-       naive   =              FiltNR.sums        n xs+sums :: NonEmpty.T Rational -> Property+sums xsc =+   ($ NonEmpty.toList xsc) $ \xs ->+   QC.forAll (QC.choose (1, length xs)) $ \n ->+   let naive   =              FiltNR.sums        n xs        pyramid =              FiltNR.sumsPyramid n xs        rec     = drop (n-1) $ MA.sumsStaticInt   n xs    in  -- this checks only for equal prefixes and can easily go wrong,@@ -52,11 +49,12 @@        and $ zipWith3 (\x y z -> x==y && y==z) naive rec pyramid        -- equalList $ naive : pyramid : rec : [] -sumRange :: NonNeg.Int -> (NonNeg.Int, NonNeg.Int) -> Sig.T Int -> Bool-sumRange nheight (nl,nr) xs =-   let wrap n = mod (NonNeg.toNumber n) (length xs + 1)-       height = 1 + NonNeg.toNumber nheight-       rng = (wrap nl, wrap nr)+sumRange :: Sig.T Int -> Property+sumRange xs =+   QC.forAll (fmap (succ . NonNeg.toNumber) arbitrary) $ \height ->+   QC.forAll (QC.choose (0, length xs)) $ \nl ->+   QC.forAll (QC.choose (0, length xs)) $ \nr ->+   let rng = (nl, nr)        pyr = take height (FiltNR.pyramid xs)        pyrSt =           FiltNRSt.pyramid (+) height@@ -71,25 +69,33 @@        FiltNRG.sumRangeFromPyramidReverse pyrSt rng :        [] -getRange :: (NonNeg.Int, NonNeg.Int) -> NonEmpty.T (NonEmpty.T ArbChar) -> Bool-getRange (nl,nr) pyr0 =-   let l = NonNeg.toNumber nl-       r = NonNeg.toNumber nr-       rng = if l<=r then (l,r) else (r,l)+newtype Size = Size {getSize :: Int}+   deriving (Eq, Ord, Show)++sizeRange :: (Int, Int)+sizeRange = (0,1000)++instance QC.Arbitrary Size where+   arbitrary = fmap Size $ QC.choose sizeRange+   shrink (Size n) =+      map Size $ filter (inRange sizeRange) $ QC.shrink n+++getRange :: (Size, Size) -> NonEmpty.T (NonEmpty.T ArbChar) -> Bool+getRange nrng pyr0 =+   let rng = sortPair $ mapPair (getSize, getSize) nrng        pyr = map NonEmpty.toInfiniteList $ NonEmpty.toList pyr0    in  equalList $        FiltNR.getRangeFromPyramid pyr rng :        FiltNRG.consumeRangeFromPyramid (:) [] pyr rng :        [] -sumsPosModulated ::-   NonNeg.Int -> Sig.T (NonNeg.Int,NonNeg.Int) -> NonEmpty.T Int -> Bool-sumsPosModulated nheight nctrl xsc =-   let ctrl = map (mapPair (NonNeg.toNumber, NonNeg.toNumber)) nctrl+sumsPosModulated :: Sig.T (Size, Size) -> NonEmpty.T Int -> Property+sumsPosModulated nctrl xsc =+   QC.forAll (QC.choose (0,10)) $ \height ->+   let ctrl = map (mapPair (getSize, getSize)) nctrl        xs = NonEmpty.toInfiniteList xsc-       height = min 10 $ NonNeg.toNumber nheight-   in  -- trace (show (height, ctrl, xsc)) $-       equalList $+   in  equalList $        FiltNR.sumsPosModulated ctrl xs :        FiltNR.sumsPosModulatedPyramid height ctrl xs :        FiltNRG.sumsPosModulatedPyramid height ctrl xs :@@ -110,19 +116,17 @@           ctrl :        [] -minPosModulated ::-   NonNeg.Int -> Sig.T (NonNeg.Int,NonNeg.Int) -> NonEmpty.T Int -> Bool-minPosModulated nheight nctrl xsc =+minPosModulated :: Sig.T (Size, Size) -> NonEmpty.T Int -> Property+minPosModulated nctrl xsc =+   QC.forAll (QC.choose (0,10)) $ \height ->    let ctrl =-          map (\(nl,nr) ->-             if nl==nr-               then (NonNeg.toNumber nl, NonNeg.toNumber nr+1)-               else (NonNeg.toNumber nl, NonNeg.toNumber nr))+          map+             ((\(nl,nr) -> (nl, if nl==nr then nr+1 else nr))+              .+              mapPair (getSize, getSize))              nctrl        xs = NonEmpty.toInfiniteList xsc-       height = min 10 $ NonNeg.toNumber nheight-   in  -- trace (show (height, ctrl, xsc)) $-       equalList $+   in  equalList $        zipWith FiltNR.minRange (List.tails xs) ctrl :        SigSt.toList           (FiltNRSt.accumulateBinPosModulatedPyramid min height@@ -130,33 +134,35 @@              (SigSt.fromList SigSt.defaultChunkSize xs)) :        [] -downSample2 ::-   [Int] -> (Int, Sig.T Int) -> Bool-downSample2 lazySize xsc =-   let len = Chunky.fromChunks $ map (VP.chunkSize . succ . abs) lazySize-       xs = VP.pack len $ cycle $ uncurry (:) xsc-   in  equalList $-       FiltNRG.downsample2 SigG.defaultLazySize xs :-       FiltNRSt.downsample2 xs :-       [] -sumsDownSample2 ::-   [Int] -> (Int, Sig.T Int) -> Bool-sumsDownSample2 lazySize xsc =-   let len = Chunky.fromChunks $ map (VP.chunkSize . succ . abs) lazySize-       xs = VP.pack len $ cycle $ uncurry (:) xsc-   in  equalList $-       FiltNRG.sumsDownsample2 SigG.defaultLazySize xs :-       FiltNRSt.sumsDownsample2 xs :-       FiltNRSt.sumsDownsample2Alt xs :-       []+genChunkyVector :: QC.Gen (VP.Vector Int)+genChunkyVector =+   liftA2 VP.pack+      (Chunky.fromChunks <$> arbitrary)+      (NonEmpty.toInfiniteList <$> arbitrary) +downSample2 :: Property+downSample2 =+   QC.forAll genChunkyVector $ \xs ->+   equalList $+      FiltNRG.downsample2 SigG.defaultLazySize xs :+      FiltNRSt.downsample2 xs :+      []++sumsDownSample2 :: Property+sumsDownSample2 =+   QC.forAll genChunkyVector $ \xs ->+   equalList $+      FiltNRG.sumsDownsample2 SigG.defaultLazySize xs :+      FiltNRSt.sumsDownsample2 xs :+      FiltNRSt.sumsDownsample2Alt xs :+      []+ {--sumsDownSample2 ::-   [VP.ChunkSize] -> (Int, Sig.T Int) -> Bool+sumsDownSample2 :: [VP.ChunkSize] -> NonEmpty.T Int -> Bool sumsDownSample2 lazySize xsc =    let len = Chunky.fromChunks $ filter (0/=) lazySize-       xs = VP.pack len $ cycle $ uncurry (:) xsc+       xs = VP.pack len $ NonEmpty.toInfiniteList xsc    in  equalList $        FiltNRG.sumsDownsample2 SigG.defaultLazySize xs :        FiltNRSt.sumsDownsample2 xs :@@ -165,18 +171,16 @@ -}  movingAverageModulatedPyramid ::-   NonNeg.Int -> Sig.T NonNeg.Int ->-   (Stereo.T GF.T, Sig.T (Stereo.T GF.T)) -> Bool-movingAverageModulatedPyramid nheight nctrl xsc =-   let ctrl = map NonNeg.toNumber nctrl-       xs = uncurry (:) xsc+   Sig.T Size -> NonEmpty.T (Stereo.T GF.T) -> Property+movingAverageModulatedPyramid nctrl xsc =+   QC.forAll (QC.choose (0,10)) $ \height ->+   let ctrl = map getSize nctrl+       xs = NonEmpty.toList xsc        pack ys = SigSt.fromList SigSt.defaultChunkSize ys        maxC = maximum ctrl-       height = min 10 $ NonNeg.toNumber nheight        onegf :: GF.T        onegf = one-   in  -- trace (show (height, ctrl, xsc)) $-       equalList $+   in  equalList $        pack (FiltNR.movingAverageModulatedPyramid onegf           height maxC ctrl (cycle xs)) :        FiltNRG.movingAverageModulatedPyramid onegf
test/Test/Sound/Synthesizer/Plain/Filter/Allpass.hs view
@@ -15,8 +15,6 @@  import Control.Monad.Trans.State (runState, ) --- import Debug.Trace (trace, )- import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()
test/Test/Sound/Synthesizer/Plain/Filter/Hilbert.hs view
@@ -19,8 +19,6 @@  import Data.Tuple.HT (mapPair, ) --- import Debug.Trace (trace, )- import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()
test/Test/Sound/Synthesizer/Plain/Interpolation.hs view
@@ -14,7 +14,6 @@ import qualified Synthesizer.Interpolation.Class as Interpol import qualified Synthesizer.Interpolation.Custom as ExampleCustom import qualified Synthesizer.Interpolation.Module as ExampleModule-import qualified Synthesizer.Interpolation as InterpolationCore  import qualified Synthesizer.Causal.Interpolation as InterpolC import qualified Synthesizer.Causal.Process as Causal@@ -26,8 +25,7 @@ import qualified Synthesizer.Storable.Filter.NonRecursive as FiltSt import qualified Synthesizer.Storable.Signal as SigSt -import Test.QuickCheck (quickCheck, Arbitrary(arbitrary), elements, {- Property, (==>), -} Testable, )--- import Test.Utility+import Test.QuickCheck (quickCheck, Arbitrary(arbitrary), elements, Testable, )  import Foreign.Storable (Storable, ) @@ -35,14 +33,12 @@ import qualified Algebra.Module                as Module import qualified Algebra.RealField             as RealField import qualified Algebra.Field                 as Field-import qualified Algebra.RealRing                  as RealRing--- import qualified Algebra.Ring                  as Ring--- import qualified Algebra.Additive              as Additive+import qualified Algebra.RealRing              as RealRing -import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty import qualified Data.List.Match as Match-import Control.Monad (liftM2, )+import Data.Tuple.HT (mapSnd, ) +import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty import Test.Utility (equalList, ArbChar, unpackArbString, )  @@ -52,13 +48,6 @@   -instance Arbitrary InterpolationCore.Margin where-   arbitrary =-      liftM2 InterpolationCore.Margin-         (fmap abs arbitrary)-         (fmap abs arbitrary)-- use ::    (Interpolation.T a v -> x) ->    (T a v -> x)@@ -246,10 +235,6 @@           SigG.defaultLazySize cs xs  -makeChunkSize :: Int -> SigSt.ChunkSize-makeChunkSize size =-   SigSt.chunkSize (1 + abs size)- {- makeExactFraction :: (Int,Int) -> Double makeExactFraction (n,d) =@@ -258,58 +243,45 @@  frequencyModulationStorableChunkSize ::    (Storable v, RealField.C t, Eq v) =>-   Int -> Int ->-   Int -> Int ->+   SigSt.ChunkSize -> SigSt.ChunkSize ->+   SigSt.ChunkSize -> SigSt.ChunkSize ->    [t] -> [v] ->    Bool frequencyModulationStorableChunkSize size0 size1 xsize0 xsize1 cs xs =-   FiltSt.inverseFrequencyModulationFloor-     (makeChunkSize size0) cs-     (SigSt.fromList (makeChunkSize xsize0) xs)-    ==-   FiltSt.inverseFrequencyModulationFloor-     (makeChunkSize size1) cs-     (SigSt.fromList (makeChunkSize xsize1) xs)+   uncurry (==) $+   frequencyModulationStorableChunkSizeCompare size0 size1 xsize0 xsize1 cs xs   frequencyModulationStorableChunkSizeCompare ::    (Storable v, RealField.C t, Eq v) =>-   Int -> Int ->-   Int -> Int ->+   SigSt.ChunkSize -> SigSt.ChunkSize ->+   SigSt.ChunkSize -> SigSt.ChunkSize ->    [t] -> [v] ->    (SigSt.T v, SigSt.T v) frequencyModulationStorableChunkSizeCompare size0 size1 xsize0 xsize1 cs xs =-   (FiltSt.inverseFrequencyModulationFloor-      (makeChunkSize size0) cs-      (SigSt.fromList (makeChunkSize xsize0) xs),-    FiltSt.inverseFrequencyModulationFloor-      (makeChunkSize size1) cs-      (SigSt.fromList (makeChunkSize xsize1) xs))+   (FiltSt.inverseFrequencyModulationFloor size0 cs (SigSt.fromList xsize0 xs),+    FiltSt.inverseFrequencyModulationFloor size1 cs (SigSt.fromList xsize1 xs))   frequencyModulationStorable ::    (Storable v, RealField.C t, Eq v) =>-   Int -> Int ->+   SigSt.ChunkSize -> SigSt.ChunkSize ->    [t] -> [v] ->    Bool frequencyModulationStorable size xsize cs xs =-   SigSt.toList-      (FiltSt.inverseFrequencyModulationFloor (makeChunkSize size) cs-         (SigSt.fromList (makeChunkSize xsize) xs))-    == FiltG.inverseFrequencyModulationFloor-          SigG.defaultLazySize cs xs-+   uncurry (==) $ mapSnd SigSt.toList $+   frequencyModulationStorableCompare size xsize cs xs  frequencyModulationStorableCompare ::    (Storable v, RealField.C t, Eq v) =>-   Int -> Int ->+   SigSt.ChunkSize -> SigSt.ChunkSize ->    [t] -> [v] ->    ([v], SigSt.T v) frequencyModulationStorableCompare size xsize cs xs =    (FiltG.inverseFrequencyModulationFloor        SigG.defaultLazySize cs xs,-    FiltSt.inverseFrequencyModulationFloor (makeChunkSize size) cs-       (SigSt.fromList (makeChunkSize xsize) xs))+    FiltSt.inverseFrequencyModulationFloor size cs+       (SigSt.fromList xsize xs))
test/Test/Sound/Synthesizer/Plain/Oscillator.hs view
@@ -2,15 +2,12 @@  import qualified Synthesizer.Plain.Oscillator as Osci import qualified Synthesizer.Basic.Wave       as Wave--- import qualified Synthesizer.Plain.Interpolation as Interpolation -import qualified Test.Sound.Synthesizer.Plain.Wave          as WaveTest--- import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest+import qualified Test.Sound.Synthesizer.Plain.Wave as WaveTest -import Test.QuickCheck (quickCheck, {- Property, (==>), -} )+import Test.QuickCheck (quickCheck, )  import qualified Algebra.RealField             as RealField-  import NumericPrelude.Numeric import NumericPrelude.Base
test/Test/Sound/Synthesizer/Plain/ToneModulation.hs view
@@ -20,6 +20,7 @@ import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest +import qualified Test.QuickCheck as QC import Test.QuickCheck (quickCheck, Property, (==>), ) import Test.Utility (ArbChar, ) @@ -29,6 +30,7 @@ import qualified Algebra.RealTranscendental    as RealTrans import qualified Algebra.Module                as Module import qualified Algebra.RealField             as RealField+import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive import qualified Algebra.ZeroTestable          as ZeroTestable @@ -37,7 +39,9 @@ import Data.Tuple.HT (mapPair, mapSnd, ) import qualified Data.List as List +import System.Random (Random, ) + import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()@@ -117,14 +121,15 @@    in  map (flip ToneModL.dropRem xs) [0 .. n + length xs] ==        map ((,) 0) (List.tails xs) ++ map (flip (,) []) [1..n] +ten, hundred :: (Ring.C a) => a+ten = fromInteger 10; hundred = fromInteger 100 -sampledToneSine :: (RealTrans.C a, Module.C a a) =>-   NonNeg.T a -> NonNeg.Int -> a -> a -> a -> Bool-sampledToneSine periodNN ext phase0 shape phase =+sampledToneSine :: (RealTrans.C a, Module.C a a, Show a, Random a) =>+   NonNeg.Int -> a -> a -> a -> Property+sampledToneSine ext phase0 shape phase =+   QC.forAll (QC.choose (ten,hundred)) $ \period ->    let ipLeap = Interpolation.cubic        ipStep = Interpolation.cubic-       ten = fromInteger 10-       period = ten + NonNeg.toNumber periodNN        periodInt = round period        len = minLength ipLeap ipStep periodInt ext        tone = take len (Osci.staticSine phase0 (recip period))@@ -132,13 +137,12 @@             head (Osci.staticSine (phase0+phase) zero)) < ten ^- (-2)  -sampledToneSineList :: (RealTrans.C a, Module.C a a) =>-   NonNeg.T a -> NonNeg.Int -> a -> a -> [a] -> [a] -> Bool-sampledToneSineList periodNN ext origPhase phase shapes freqs =+sampledToneSineList :: (RealTrans.C a, Module.C a a, Show a, Random a) =>+   NonNeg.Int -> a -> a -> [a] -> [a] -> Property+sampledToneSineList ext origPhase phase shapes freqs =+   QC.forAll (QC.choose (ten,hundred)) $ \period ->    let ipLeap = Interpolation.cubic        ipStep = Interpolation.cubic-       ten = fromInteger 10-       period = ten + NonNeg.toNumber periodNN        periodInt = round period        len = minLength ipLeap ipStep periodInt ext        tone = take len (Osci.staticSine origPhase (recip period))@@ -440,9 +444,9 @@                               quickCheck limitMaxRelativeValuesNonNegInfinity) :    ("dropRem",                quickCheck (dropRem :: NonNeg.Int -> [ArbChar] -> Bool)) :    ("sampledToneSine",-      quickCheck (\period -> sampledToneSine (period :: NonNeg.Double))) :+      quickCheck (\ext phase0 -> sampledToneSine ext (phase0 :: Double))) :    ("sampledToneSineList",-      quickCheck (\period -> sampledToneSineList (period :: NonNeg.Double))) :+      quickCheck (\ext phase0 -> sampledToneSineList ext (phase0 :: Double))) :    ("sampledToneLinear",       testRationalLineIp sampledToneLinear) :    ("sampledToneStair",
test/Test/Sound/Synthesizer/Plain/Wave.hs view
@@ -3,10 +3,9 @@ import qualified Synthesizer.Basic.Wave       as Wave import qualified Synthesizer.Basic.Phase      as Phase -import Test.QuickCheck (quickCheck, Arbitrary(arbitrary), elements, oneof, choose, {- Property, (==>), -} )--- import Test.Utility--import qualified Number.NonNegative       as NonNeg+import qualified Test.QuickCheck as QC+import Test.QuickCheck+         (quickCheck, Arbitrary(arbitrary), elements, oneof, choose, )  import qualified Algebra.RealTranscendental    as RealTrans import qualified Algebra.Ring                  as Ring@@ -60,10 +59,10 @@             []  -zeroDCOffset :: ZeroDCOffset Double -> NonNeg.Int -> Bool-zeroDCOffset w periodIntNN =-   let periodInt = 100 + NonNeg.toNumber periodIntNN-       period    = fromIntegral periodInt+zeroDCOffset :: ZeroDCOffset Double -> QC.Property+zeroDCOffset w =+   QC.forAll (QC.choose (100,600)) $ \periodInt ->+   let period    = fromIntegral periodInt        xs = take periodInt $ map Phase.fromRepresentative $             map (/period) $ iterate (1+) 0.5    in  abs (sum (map (Wave.apply (zdcWave w)) xs))  <  period / fromInteger 100
test/Test/Sound/Synthesizer/Storable/Cut.hs view
@@ -8,12 +8,9 @@  import qualified Data.EventList.Relative.TimeBody  as EventList --- import qualified Algebra.RealRing                  as RealRing--- import qualified Algebra.Ring                  as Ring--- import qualified Algebra.Additive              as Additive- import qualified Number.NonNegative as NonNeg +import qualified Test.QuickCheck as QC import Test.QuickCheck (quickCheck, ) import Test.Utility (equalList, ) @@ -22,10 +19,13 @@ import Prelude ()  -arrange :: NonNeg.Int -> EventList.T NonNeg.Int (Sig.T Int) -> Bool-arrange nnChunkSize evs =-   let chunkSize = SigSt.chunkSize $ 1 + NonNeg.toNumber nnChunkSize-       sevs = EventList.mapBody (SigSt.fromList chunkSize) evs+genEventList :: QC.Gen (EventList.T NonNeg.Int (Sig.T Int))+genEventList = fmap (EventList.mapTime (flip mod 1000)) QC.arbitrary++arrange :: SigSt.ChunkSize -> QC.Property+arrange chunkSize =+   QC.forAll genEventList $ \evs ->+   let sevs = EventList.mapBody (SigSt.fromList chunkSize) evs    in  equalList $        SigSt.fromList chunkSize (Cut.arrange evs) :        CutSt.arrangeAdaptive chunkSize sevs :
test/Test/Utility.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} module Test.Utility where +import qualified Test.QuickCheck as QC import Test.QuickCheck (Arbitrary(arbitrary))  import qualified Number.Complex as Complex@@ -62,7 +63,7 @@    showsPrec n (ArbChar c) = showsPrec n c  instance Arbitrary ArbChar where-   arbitrary = fmap (ArbChar . Char.chr . (32+) . flip mod 96) arbitrary+   arbitrary = fmap (ArbChar . Char.chr) (QC.choose (32,127))  unpackArbString :: [ArbChar] -> String unpackArbString =