{-# LANGUAGE NoImplicitPrelude #-} {- | Copyright : (c) Henning Thielemann 2008 License : GPL Maintainer : synthesizer@henning-thielemann.de Stability : provisional Portability : requires multi-parameter type classes -} module Synthesizer.SampleRateContext.Noise (white, whiteBandEnergy, randomPeeks, whiteGen, whiteBandEnergyGen, randomPeeksGen, ) where import qualified Synthesizer.Plain.Noise as Noise import qualified Synthesizer.SampleRateContext.Signal as SigC import qualified Synthesizer.SampleRateContext.Rate as Rate import qualified Algebra.OccasionallyScalar as OccScalar import qualified Algebra.Algebraic as Algebraic import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import System.Random (Random, RandomGen, randomRs, mkStdGen) import NumericPrelude import PreludeBase as P {- | Uniformly distributed white noise. The volume is given by two values: The width of a frequency band and the volume caused by it. The width of a frequency band must be given in order to achieve independence from sample rate. See 'whiteBandEnergy'. -} white :: (Ring.C yv, Random yv, Algebraic.C q') => q' {-^ width of the frequency band -} -> q' {-^ volume caused by the given frequency band -} -> Rate.T t q' -> SigC.T y q' yv {-^ noise -} white = whiteGen (mkStdGen 6746) whiteGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') => g {-^ random generator, can be used to choose a seed -} -> q' {-^ width of the frequency band -} -> q' {-^ volume caused by the given frequency band -} -> Rate.T t q' -> SigC.T y q' yv {-^ noise -} whiteGen gen bandWidth volume sr = SigC.Cons (sqrt (3 * bandWidth / Rate.toNumber sr) * volume) (Noise.whiteGen gen) {-| Uniformly distributed white noise. Instead of an amplitude you must specify a value that is like an energy per frequency band. It makes no sense to specify an amplitude because if you keep the same signal amplitude while increasing the sample rate by a factor of four the amplitude of the frequency spectrum halves. Thus deep frequencies would be damped when higher frequencies enter. Example: If your signal is a function from time to voltage, the amplitude must have the unit @volt^2*second@, which can be also viewed as @volt^2\/hertz@. Note that the energy is proportional to the square of the signal amplitude. In order to double the noise amplitude, you must increase the energy by a factor of four. Using this notion of amplitude the behaviour amongst several frequency filters is quite consistent but a problem remains: When the noise is quantised then noise at low sample rates and noise at high sample rates behave considerably different. This indicates that quantisation should not just pick values, but it should average over the hold periods. -} whiteBandEnergy :: (Ring.C yv, Random yv, Algebraic.C q') => q' {-^ energy per frequency band -} -> Rate.T t q' -> SigC.T y q' yv {-^ noise -} whiteBandEnergy = whiteBandEnergyGen (mkStdGen 6746) whiteBandEnergyGen :: (Ring.C yv, Random yv, RandomGen g, Algebraic.C q') => g {-^ random generator, can be used to choose a seed -} -> q' {-^ energy per frequency band -} -> Rate.T t q' -> SigC.T y q' yv {-^ noise -} whiteBandEnergyGen gen energy sr = SigC.Cons (sqrt (3 * Rate.toNumber sr * energy)) (Noise.whiteGen gen) {- The Field.C q constraint could be lifted to Ring.C if we would use direct division instead of toFrequencyScalar. -} randomPeeks :: (Field.C q, Random q, Ord q, Field.C q', OccScalar.C q q') => Rate.T q q' -> SigC.T q q' q {- ^ momentary densities (frequency), @p@ means that there is about one peak in the time range of @1\/p@. -} -> [Bool] {- ^ Every occurence of 'True' represents a peak. -} randomPeeks = randomPeeksGen (mkStdGen 876) randomPeeksGen :: (Field.C q, Random q, Ord q, Field.C q', OccScalar.C q q', RandomGen g) => g {-^ random generator, can be used to choose a seed -} -> Rate.T q q' -> SigC.T q q' q {- ^ momentary densities (frequency), @p@ means that there is about one peak in the time range of @1\/p@. -} -> [Bool] {- ^ Every occurence of 'True' represents a peak. -} randomPeeksGen g sr dens = let amp = SigC.toFrequencyScalar sr (SigC.amplitude dens) in zipWith (<) (randomRs (0, recip amp) g) (SigC.samples dens)