{-# LANGUAGE NoImplicitPrelude #-}
{- |
Noise and random processes.
This uses a fast reimplementation of 'System.Random.randomR'
since the standard function seems not to be inlined (at least in GHC-6.8.2).
-}
module Synthesizer.State.NoiseCustom where

import qualified Synthesizer.State.Signal as Sig

import qualified Synthesizer.RandomKnuth as Knuth
import qualified System.Random as Rnd
import System.Random (Random, RandomGen, )

import qualified Algebra.RealField             as RealField
import qualified Algebra.Field                 as Field

import NumericPrelude.Numeric
import NumericPrelude.Base


{-|
Deterministic white noise, uniformly distributed between -1 and 1.
That is, variance is 1\/3.
-}
{-# INLINE white #-}
white :: (Field.C y, Random y) =>
   Sig.T y
white :: forall y. (C y, Random y) => T y
white = forall y g. (C y, Random y, RandomGen g) => g -> T y
whiteGen (Int -> T
Knuth.cons Int
12354)

{-# INLINE whiteGen #-}
whiteGen ::
   (Field.C y, Random y, RandomGen g) =>
   g -> Sig.T y
whiteGen :: forall y g. (C y, Random y, RandomGen g) => g -> T y
whiteGen = forall y g. (C y, Random y, RandomGen g) => (y, y) -> g -> T y
randomRs (-y
1,y
1)


{- |
Approximates normal distribution with variance 1
by a quadratic B-spline distribution.
-}
{-# INLINE whiteQuadraticBSplineGen #-}
whiteQuadraticBSplineGen ::
   (Field.C y, Random y, RandomGen g) =>
   g -> Sig.T y
whiteQuadraticBSplineGen :: forall y g. (C y, Random y, RandomGen g) => g -> T y
whiteQuadraticBSplineGen g
g =
   let (g
g0,g
gr) = forall g. RandomGen g => g -> (g, g)
Rnd.split g
g
       (g
g1,g
g2) = forall g. RandomGen g => g -> (g, g)
Rnd.split g
gr
   in  forall y g. (C y, Random y, RandomGen g) => g -> T y
whiteGen g
g0 forall a. C a => T a -> T a -> T a
`Sig.mix`
       forall y g. (C y, Random y, RandomGen g) => g -> T y
whiteGen g
g1 forall a. C a => T a -> T a -> T a
`Sig.mix`
       forall y g. (C y, Random y, RandomGen g) => g -> T y
whiteGen g
g2


{-# INLINE randomPeeks #-}
randomPeeks :: (RealField.C y, Random y) =>
      Sig.T y    {- ^ momentary densities, @p@ means that there is about one peak
                      in the time range of @1\/p@ samples -}
   -> Sig.T Bool {- ^ Every occurence of 'True' represents a peak. -}
randomPeeks :: forall y. (C y, Random y) => T y -> T Bool
randomPeeks =
   forall y g. (C y, Random y, RandomGen g) => g -> T y -> T Bool
randomPeeksGen (Int -> T
Knuth.cons Int
876)

{-# INLINE randomPeeksGen #-}
randomPeeksGen :: (RealField.C y, Random y, RandomGen g) =>
      g
   -> Sig.T y
   -> Sig.T Bool
randomPeeksGen :: forall y g. (C y, Random y, RandomGen g) => g -> T y -> T Bool
randomPeeksGen =
   forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith forall a. Ord a => a -> a -> Bool
(<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y g. (C y, Random y, RandomGen g) => (y, y) -> g -> T y
randomRs (y
0,y
1)


{-# INLINE randomRs #-}
randomRs ::
   (Field.C y, Random y, RandomGen g) =>
   (y,y) -> g -> Sig.T y
randomRs :: forall y g. (C y, Random y, RandomGen g) => (y, y) -> g -> T y
randomRs (y, y)
bnd = forall acc y. (acc -> Maybe (y, acc)) -> acc -> T y
Sig.unfoldR (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g y. (RandomGen g, C y) => (y, y) -> g -> (y, g)
randomR (y, y)
bnd)

{-# INLINE randomR #-}
randomR ::
   (RandomGen g, Field.C y) =>
   (y, y) -> g -> (y, g)
randomR :: forall g y. (RandomGen g, C y) => (y, y) -> g -> (y, g)
randomR (y
lower,y
upper) g
g0 =
   let (Int
n,g
g1) = forall g. RandomGen g => g -> (Int, g)
Rnd.next g
g0
       (Int
l,Int
u) = forall g. RandomGen g => g -> (Int, Int)
Rnd.genRange g
g0
       nd :: y
nd = forall a b. (C a, C b) => a -> b
fromIntegral Int
n
       ld :: y
ld = forall a b. (C a, C b) => a -> b
fromIntegral Int
l
       ud :: y
ud = forall a b. (C a, C b) => a -> b
fromIntegral Int
u
       x01 :: y
x01 = (y
ndforall a. C a => a -> a -> a
-y
ld)forall a. C a => a -> a -> a
/(y
udforall a. C a => a -> a -> a
-y
ld)
   in  ((y
1forall a. C a => a -> a -> a
-y
x01)forall a. C a => a -> a -> a
*y
lower forall a. C a => a -> a -> a
+ y
x01forall a. C a => a -> a -> a
*y
upper, g
g1)