module Data.Random.Distribution.Uniform
( Uniform(..)
, uniform
, StdUniform(..)
, stdUniform
, stdUniformPos
, integralUniform
, realFloatUniform
, floatUniform
, doubleUniform
, fixedUniform
, boundedStdUniform
, boundedEnumStdUniform
, realFloatStdUniform
, fixedStdUniform
, floatStdUniform
, doubleStdUniform
, realStdUniformCDF
, realUniformCDF
) where
import Data.Random.Internal.TH
import Data.Random.Internal.Words
import Data.Random.Internal.Fixed
import Data.Random.Source
import Data.Random.Distribution
import Data.Random.RVar
import Data.Fixed
import Data.Word
import Data.Int
import Data.List
import Control.Monad.Loops
integralUniform :: (Integral a) => a -> a -> RVar a
integralUniform !x !y = if x < y then integralUniform' x y else integralUniform' y x
integralUniform' :: (Integral a) => a -> a -> RVar a
integralUniform' !l !u
| nReject == 0 = fmap shift prim
| otherwise = fmap shift loop
where
m = 1 + toInteger u toInteger l
(bytes, nPossible) = bytesNeeded m
nReject = nPossible `mod` m
!prim = getRandomPrim (PrimNByteInteger bytes)
!shift = \(!z) -> l + (fromInteger $! (z `mod` m))
loop = do
z <- prim
if z < nReject
then loop
else return z
integralUniformCDF :: (Integral a, Fractional b) => a -> a -> a -> b
integralUniformCDF a b x
| b < a = integralUniformCDF b a x
| x < a = 0
| x > b = 1
| otherwise = (fromIntegral x fromIntegral a) / (fromIntegral b fromIntegral a)
bytesNeeded :: Integer -> (Int, Integer)
bytesNeeded x = head (dropWhile ((<= x).snd) powersOf256)
powersOf256 :: [(Int, Integer)]
powersOf256 = zip [0..] (iterate (256 *) 1)
boundedStdUniform :: (Distribution Uniform a, Bounded a) => RVar a
boundedStdUniform = uniform minBound maxBound
boundedStdUniformCDF :: (CDF Uniform a, Bounded a) => a -> Double
boundedStdUniformCDF = cdf (Uniform minBound maxBound)
boundedEnumStdUniform :: (Enum a, Bounded a) => RVar a
boundedEnumStdUniform = enumUniform minBound maxBound
boundedEnumStdUniformCDF :: (Enum a, Bounded a, Ord a) => a -> Double
boundedEnumStdUniformCDF = enumUniformCDF minBound maxBound
floatStdUniform :: RVar Float
floatStdUniform = do
x <- getRandomPrim PrimWord32
return (word32ToFloat x)
doubleStdUniform :: RVar Double
doubleStdUniform = getRandomPrim PrimDouble
realFloatStdUniform :: RealFloat a => RVar a
realFloatStdUniform = do
let (b, e) = decodeFloat one
x <- uniform 0 (b1)
if x == 0
then return (0 `asTypeOf` one)
else return (encodeFloat x e)
where one = 1
fixedStdUniform :: HasResolution r => RVar (Fixed r)
fixedStdUniform = x
where
res = resolutionOf2 x
x = do
u <- uniform 0 (res)
return (mkFixed u)
realStdUniformCDF :: Real a => a -> Double
realStdUniformCDF x
| x <= 0 = 0
| x >= 1 = 1
| otherwise = realToFrac x
floatUniform :: Float -> Float -> RVar Float
floatUniform 0 1 = floatStdUniform
floatUniform a b = do
x <- floatStdUniform
return (a + x * (b a))
doubleUniform :: Double -> Double -> RVar Double
doubleUniform 0 1 = doubleStdUniform
doubleUniform a b = do
x <- doubleStdUniform
return (a + x * (b a))
realFloatUniform :: RealFloat a => a -> a -> RVar a
realFloatUniform 0 1 = realFloatStdUniform
realFloatUniform a b = do
x <- realFloatStdUniform
return (a + x * (b a))
fixedUniform :: HasResolution r => Fixed r -> Fixed r -> RVar (Fixed r)
fixedUniform a b = do
u <- integralUniform (unMkFixed a) (unMkFixed b)
return (mkFixed u)
realUniformCDF :: RealFrac a => a -> a -> a -> Double
realUniformCDF a b x
| b < a = realUniformCDF b a x
| x <= a = 0
| x >= b = 1
| otherwise = realToFrac ((xa) / (ba))
enumUniform :: Enum a => a -> a -> RVar a
enumUniform a b = do
x <- integralUniform (fromEnum a) (fromEnum b)
return (toEnum x)
enumUniformCDF :: (Enum a, Ord a) => a -> a -> a -> Double
enumUniformCDF a b x
| b < a = enumUniformCDF b a x
| x <= a = 0
| x >= b = 1
| otherwise = (e2f x e2f a) / (e2f b e2f a)
where e2f = fromIntegral . fromEnum
uniform :: Distribution Uniform a => a -> a -> RVar a
uniform a b = rvar (Uniform a b)
stdUniform :: (Distribution StdUniform a) => RVar a
stdUniform = rvar StdUniform
stdUniformNonneg :: (Distribution StdUniform a, Num a) => RVar a
stdUniformNonneg = fmap abs stdUniform
stdUniformPos :: (Distribution StdUniform a, Num a) => RVar a
stdUniformPos = iterateUntil (/= 0) stdUniformNonneg
data Uniform t =
Uniform !t !t
data StdUniform t = StdUniform
$( replicateInstances ''Int integralTypes [d|
instance Distribution Uniform Int where rvar (Uniform a b) = integralUniform a b
instance CDF Uniform Int where cdf (Uniform a b) = integralUniformCDF a b
|])
instance Distribution StdUniform Word8 where rvarT ~StdUniform = getRandomPrim PrimWord8
instance Distribution StdUniform Word16 where rvarT ~StdUniform = getRandomPrim PrimWord16
instance Distribution StdUniform Word32 where rvarT ~StdUniform = getRandomPrim PrimWord32
instance Distribution StdUniform Word64 where rvarT ~StdUniform = getRandomPrim PrimWord64
instance Distribution StdUniform Int8 where rvarT ~StdUniform = fromIntegral `fmap` getRandomPrim PrimWord8
instance Distribution StdUniform Int16 where rvarT ~StdUniform = fromIntegral `fmap` getRandomPrim PrimWord16
instance Distribution StdUniform Int32 where rvarT ~StdUniform = fromIntegral `fmap` getRandomPrim PrimWord32
instance Distribution StdUniform Int64 where rvarT ~StdUniform = fromIntegral `fmap` getRandomPrim PrimWord64
instance Distribution StdUniform Int where
rvar
| toInteger (maxBound :: Int) > toInteger (maxBound :: Int32)
= const (fromIntegral `fmap` getRandomPrim PrimWord64)
| otherwise
= const (fromIntegral `fmap` getRandomPrim PrimWord32)
instance Distribution StdUniform Word where
rvar
| toInteger (maxBound :: Word) > toInteger (maxBound :: Word32)
= const (fromIntegral `fmap` getRandomPrim PrimWord64)
| otherwise
= const (fromIntegral `fmap` getRandomPrim PrimWord32)
$( replicateInstances ''Int (integralTypes \\ [''Integer]) [d|
instance CDF StdUniform Int where cdf ~StdUniform = boundedStdUniformCDF
|])
instance Distribution Uniform Float where rvar (Uniform a b) = floatUniform a b
instance Distribution Uniform Double where rvar (Uniform a b) = doubleUniform a b
instance CDF Uniform Float where cdf (Uniform a b) = realUniformCDF a b
instance CDF Uniform Double where cdf (Uniform a b) = realUniformCDF a b
instance Distribution StdUniform Float where rvar ~StdUniform = floatStdUniform
instance Distribution StdUniform Double where rvar ~StdUniform = getRandomPrim PrimDouble; rvarT ~StdUniform = getRandomPrim PrimDouble
instance CDF StdUniform Float where cdf ~StdUniform = realStdUniformCDF
instance CDF StdUniform Double where cdf ~StdUniform = realStdUniformCDF
instance HasResolution r =>
Distribution Uniform (Fixed r) where rvar (Uniform a b) = fixedUniform a b
instance HasResolution r =>
CDF Uniform (Fixed r) where cdf (Uniform a b) = realUniformCDF a b
instance HasResolution r =>
Distribution StdUniform (Fixed r) where rvar ~StdUniform = fixedStdUniform
instance HasResolution r =>
CDF StdUniform (Fixed r) where cdf ~StdUniform = realStdUniformCDF
instance Distribution Uniform () where rvar (Uniform _ _) = return ()
instance CDF Uniform () where cdf (Uniform _ _) = return 1
$( replicateInstances ''Char [''Char, ''Bool, ''Ordering] [d|
instance Distribution Uniform Char where rvar (Uniform a b) = enumUniform a b
instance CDF Uniform Char where cdf (Uniform a b) = enumUniformCDF a b
|])
instance Distribution StdUniform () where rvarT ~StdUniform = return ()
instance CDF StdUniform () where cdf ~StdUniform = return 1
instance Distribution StdUniform Bool where rvarT ~StdUniform = fmap even (getRandomPrim PrimWord8)
instance CDF StdUniform Bool where cdf ~StdUniform = boundedEnumStdUniformCDF
instance Distribution StdUniform Char where rvar ~StdUniform = boundedEnumStdUniform
instance CDF StdUniform Char where cdf ~StdUniform = boundedEnumStdUniformCDF
instance Distribution StdUniform Ordering where rvar ~StdUniform = boundedEnumStdUniform
instance CDF StdUniform Ordering where cdf ~StdUniform = boundedEnumStdUniformCDF