Random.hs

-- |
-- Module:     FRP.NetWire.Random
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Noise generators.

module FRP.NetWire.Random
    ( -- * Impure noise generators
      noise,
      noise1,
      noiseGen,
      noiseR,
      wackelkontakt,

      -- * Pure noise generators
      pureNoise,
      pureNoiseR
    )
    where

import qualified System.Random as R
import Control.Monad
import Control.Monad.IO.Class
import FRP.NetWire.Wire
import System.Random.Mersenne


-- | Impure noise between 0 (inclusive) and 1 (exclusive).
--
-- Never inhibits.

noise :: MonadIO m => Wire m a Double
noise = noiseGen


-- | Impure noise between -1 (inclusive) and 1 (exclusive).
--
-- Never inhibits.

noise1 :: MonadIO m => Wire m a Double
noise1 =
    mkGen $ \(wsRndGen -> mt) _ -> do
        x <- liftM (pred . (2*)) . liftIO $ random mt
        x `seq` return (Right x, noise1)


-- | Impure noise.
--
-- Never inhibits.

noiseGen :: (MonadIO m, MTRandom b) => Wire m a b
noiseGen =
    mkGen $ \(wsRndGen -> mt) _ -> do
        x <- liftIO (random mt)
        x `seq` return (Right x, noiseGen)


-- | Impure noise between 0 (inclusive) and the input signal
-- (exclusive).  Note:  The noise is generated by multiplying with a
-- 'Double', hence the precision is limited.
--
-- Never inhibits.  Feedback by delay.

noiseR :: (MonadIO m, Real a, Integral b) => Wire m a b
noiseR =
    mkGen $ \(wsRndGen -> mt) n -> do
        x' <- liftIO (random mt)
        let x = floor ((x' :: Double) * realToFrac n)
        return (Right x, noiseR)


-- | Pure noise.  For impure wires it's recommended to use the impure
-- noise generators.
--
-- Never inhibits.

pureNoise :: (Monad m, R.RandomGen g, R.Random b) => g -> Wire m a b
pureNoise g' =
    mkGen $ \_ _ ->
        let (x, g) = R.random g'
        in x `seq` return (Right x, pureNoise g)


-- | Pure noise in a range.  For impure wires it's recommended to use
-- the impure noise generators.
--
-- Never inhibits.  Feedback by delay.

pureNoiseR :: (Monad m, R.RandomGen g, R.Random b) => g -> Wire m (b, b) b
pureNoiseR g' =
    mkGen $ \_ range ->
        let (x, g) = R.randomR range g'
        in return (Right x, pureNoise g)


-- | Impure random boolean.
--
-- Never inhibits.

wackelkontakt :: MonadIO m => Wire m a Bool
wackelkontakt = noiseGen