diff --git a/Data/Array/Accelerate/System/Random/MWC.hs b/Data/Array/Accelerate/System/Random/MWC.hs --- a/Data/Array/Accelerate/System/Random/MWC.hs +++ b/Data/Array/Accelerate/System/Random/MWC.hs @@ -1,17 +1,66 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module: : Data.Array.Accelerate.System.Random.MWC --- Copyright : [2014..2015] Trevor L. McDonell +-- Copyright : [2014..2020] Trevor L. McDonell -- License : BSD3 -- --- Maintainer : Trevor L. McDonell +-- Maintainer : Trevor L. McDonell -- Stability : experimental -- Portability : non-portable (GHC extensions) -- -- Random number generation backed by MWC. -- +-- [/Example/] +-- +-- Create a vector of 100 random uniformly distributed floating-point numbers, +-- where the PRNG is seeded with data from the system's source of pseudo-random +-- numbers (see 'R.withSystemRandom'): +-- +-- >>> vs <- randomArray uniform (Z :. 100) :: IO (Vector Float) +-- +-- To generate uniformly distributed random variables in the range (-1,1]: +-- +-- >>> vs <- randomArray (uniformR (-1,1)) (Z:.100) :: IO (Vector Double) +-- +-- You can also pass the generator state in explicitly, so that it can be +-- reused: +-- +-- >>> gen <- create :: IO GenIO +-- >>> vs <- randomArrayWith gen uniform (Z :. 100) :: IO (Vector Int) +-- +-- [/Non-uniform distributions/] +-- +-- If you require random numbers following other distributions, you can combine +-- this package with the generators from the +-- package. For +-- example: +-- +-- @ +-- import Data.Random hiding ( uniform ) +-- import qualified Data.Random.Distribution.Exponential as R +-- import qualified Data.Random.Distribution.Poisson as R +-- +-- exponential +-- :: (Distribution StdUniform e, Floating e, Shape sh, Elt e) +-- => e +-- -> sh :~> e +-- exponential beta _sh gen = sampleFrom gen (R.exponential beta) +-- +-- poisson +-- :: (Distribution (R.Poisson b) a, Shape sh, Elt a) +-- => b +-- -> sh :~> a +-- poisson lambda _sh gen = sampleFrom gen (R.poisson lambda) +-- @ +-- +-- Which can then be used as before: +-- +-- >>> vs <- randomArray (exponential 5) (Z :. 100) :: IO (Vector Float) +-- >>> us <- randomArray (poisson 5) (Z :. 100) :: IO (Vector Float) +-- module Data.Array.Accelerate.System.Random.MWC ( @@ -20,18 +69,20 @@ uniform, uniformR, randomArray, randomArrayWith, - -- * Re-export MWC-Random + -- Re-export MWC-Random module System.Random.MWC, ) where -import Prelude as P -import System.Random.MWC hiding ( uniform, uniformR ) -import qualified System.Random.MWC as R +import Prelude as P +import System.Random.MWC hiding ( uniform, uniformR ) +import qualified System.Random.MWC as R -import Data.Array.Accelerate as A -import Data.Array.Accelerate.Array.Data as A -import Data.Array.Accelerate.Array.Sugar as Sugar +import Data.Array.Accelerate.Array.Data +import Data.Array.Accelerate.Sugar.Array +import Data.Array.Accelerate.Sugar.Elt +import Data.Array.Accelerate.Sugar.Shape +import qualified Data.Array.Accelerate.Representation.Array as R -- | A PRNG from indices to variates @@ -56,7 +107,7 @@ -- seeded from the system's fast source of pseudo-random numbers (see: -- 'R.createSystemRandom') -- -{-# INLINE randomArray #-} +{-# INLINEABLE randomArray #-} randomArray :: (Shape sh, Elt e) => sh :~> e -> sh -> IO (Array sh e) randomArray f sh = do @@ -66,7 +117,7 @@ -- | Generate an array of random values using the supplied generator. -- -{-# INLINE randomArrayWith #-} +{-# INLINEABLE randomArrayWith #-} randomArrayWith :: (Shape sh, Elt e) => GenIO @@ -75,27 +126,28 @@ -> IO (Array sh e) randomArrayWith gen f sh = do - adata <- runRandomArray f sh gen - return $! Array (fromElt sh) adata + adata <- runRandomArray f sh gen + return $ adata `seq` Array (R.Array (fromElt sh) adata) -- Create a mutable array and fill it with random values -- -{-# INLINE runRandomArray #-} +{-# INLINEABLE runRandomArray #-} runRandomArray - :: (Shape sh, Elt e) + :: forall sh e. (Shape sh, Elt e) => sh :~> e -> sh -> GenIO - -> IO (MutableArrayData (EltRepr e)) + -> IO (MutableArrayData (EltR e)) runRandomArray f sh gen = do - arr <- newArrayData $! Sugar.size sh - let !n = Sugar.size sh - write !i + let n = size sh + arr <- newArrayData (eltR @e) n + -- + let write !i | i P.>= n = return () | otherwise = do - unsafeWriteArrayData arr i . fromElt =<< f (Sugar.fromIndex sh i) gen + writeArrayData (eltR @e) arr i . fromElt =<< f (fromIndex sh i) gen write (i+1) -- write 0 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, Trevor L. McDonell +Copyright (c) [2015..2020], Trevor L. McDonell All rights reserved. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Main where + +import Data.Array.Accelerate +import Data.Array.Accelerate.System.Random.MWC as AMWC +-- import Data.Array.Accelerate.System.Random.SFMT as ASFMT +import System.Random.MWC as MWC +-- import System.Random.SFMT as SFMT +import System.Random.Mersenne as MT +import Data.Vector.Unboxed as U + +import Criterion.Main +import Criterion.Types +import Data.Proxy +import Prelude as P + + +makeMWCArray :: forall e. Elt e => MWC.GenIO -> DIM1 AMWC.:~> e -> Benchmarkable +makeMWCArray mwc f = toBenchmarkable arr + where + arr :: Int64 -> IO () + arr n = do + !_ <- AMWC.randomArrayWith mwc f (Z :. P.fromIntegral n) :: IO (Array DIM1 e) + return () + +-- makeSFMTArray :: forall e. Elt e => SFMT.GenIO -> DIM1 ASFMT.:~> e -> Benchmarkable +-- makeSFMTArray sfmt f = Benchmarkable arr +-- where +-- arr :: Int64 -> IO () +-- arr n = do +-- !_ <- ASFMT.randomArrayWith sfmt f (Z :. P.fromIntegral n) :: IO (Array DIM1 e) +-- return () + +makeVector :: forall e. (MWC.Variate e, Unbox e) => MWC.GenIO -> Proxy e -> Benchmarkable +makeVector mwc _ = toBenchmarkable vec + where + vec :: Int64 -> IO () + vec n = do + !_ <- MWC.uniformVector mwc (P.fromIntegral n) :: IO (U.Vector e) + return () + +#if !MIN_VERSION_criterion(1,2,0) +toBenchmarkable :: (Int64 -> IO ()) -> Benchmarkable +toBenchmarkable = Benchmarkable +#endif + + +main :: IO () +main = do + mwc <- MWC.create + -- sfmt <- SFMT.create + mt <- MT.getStdGen + + defaultMain + -- One letter group names are used so they will fit on the plot. + -- + -- U - uniform + -- R - uniformR + -- D - distribution + -- + [ bgroup "mersenne-random" + [ bgroup "U" + [ bench "Double" (whnfIO (MT.random mt :: IO Double)) + , bench "Int" (whnfIO (MT.random mt :: IO Int)) + , bench "Int8" (whnfIO (MT.random mt :: IO Int8)) + , bench "Int16" (whnfIO (MT.random mt :: IO Int16)) + , bench "Int32" (whnfIO (MT.random mt :: IO Int32)) + , bench "Int64" (whnfIO (MT.random mt :: IO Int64)) + , bench "Word" (whnfIO (MT.random mt :: IO Word)) + , bench "Word8" (whnfIO (MT.random mt :: IO Word8)) + , bench "Word16" (whnfIO (MT.random mt :: IO Word16)) + , bench "Word32" (whnfIO (MT.random mt :: IO Word32)) + , bench "Word64" (whnfIO (MT.random mt :: IO Word64)) + ] + ] + + -- stolen from MWC random benchmark suite + , bgroup "mwc-random" + [ bgroup "U" + [ bench "Double" (whnfIO (MWC.uniform mwc :: IO Double)) + , bench "Float" (whnfIO (MWC.uniform mwc :: IO Float)) + , bench "Int" (whnfIO (MWC.uniform mwc :: IO Int)) + , bench "Int8" (whnfIO (MWC.uniform mwc :: IO Int8)) + , bench "Int16" (whnfIO (MWC.uniform mwc :: IO Int16)) + , bench "Int32" (whnfIO (MWC.uniform mwc :: IO Int32)) + , bench "Int64" (whnfIO (MWC.uniform mwc :: IO Int64)) + , bench "Word" (whnfIO (MWC.uniform mwc :: IO Word)) + , bench "Word8" (whnfIO (MWC.uniform mwc :: IO Word8)) + , bench "Word16" (whnfIO (MWC.uniform mwc :: IO Word16)) + , bench "Word32" (whnfIO (MWC.uniform mwc :: IO Word32)) + , bench "Word64" (whnfIO (MWC.uniform mwc :: IO Word64)) + ] + , bgroup "R" + -- I'm not entirely convinced that this is right way to test + -- uniformR. /A.Khudyakov/ + [ bench "Double" (whnfIO (MWC.uniformR (-3.21,26) mwc :: IO Double)) + , bench "Float" (whnfIO (MWC.uniformR (-3.21,26) mwc :: IO Float)) + , bench "Int" (whnfIO (MWC.uniformR (-12,679) mwc :: IO Int)) + , bench "Int8" (whnfIO (MWC.uniformR (-12,4) mwc :: IO Int8)) + , bench "Int16" (whnfIO (MWC.uniformR (-12,679) mwc :: IO Int16)) + , bench "Int32" (whnfIO (MWC.uniformR (-12,679) mwc :: IO Int32)) + , bench "Int64" (whnfIO (MWC.uniformR (-12,679) mwc :: IO Int64)) + , bench "Word" (whnfIO (MWC.uniformR (34,633) mwc :: IO Word)) + , bench "Word8" (whnfIO (MWC.uniformR (34,63) mwc :: IO Word8)) + , bench "Word16" (whnfIO (MWC.uniformR (34,633) mwc :: IO Word16)) + , bench "Word32" (whnfIO (MWC.uniformR (34,633) mwc :: IO Word32)) + , bench "Word64" (whnfIO (MWC.uniformR (34,633) mwc :: IO Word64)) + ] + , bgroup "vector" + [ bgroup "U" + [ bench "Double" (makeVector mwc (Proxy :: Proxy Double)) + , bench "Float" (makeVector mwc (Proxy :: Proxy Float)) + , bench "Int" (makeVector mwc (Proxy :: Proxy Int)) + , bench "Int8" (makeVector mwc (Proxy :: Proxy Int8)) + , bench "Int16" (makeVector mwc (Proxy :: Proxy Int16)) + , bench "Int32" (makeVector mwc (Proxy :: Proxy Int32)) + , bench "Int64" (makeVector mwc (Proxy :: Proxy Int64)) + , bench "Word" (makeVector mwc (Proxy :: Proxy Word)) + , bench "Word8" (makeVector mwc (Proxy :: Proxy Word8)) + , bench "Word16" (makeVector mwc (Proxy :: Proxy Word16)) + , bench "Word32" (makeVector mwc (Proxy :: Proxy Word32)) + , bench "Word64" (makeVector mwc (Proxy :: Proxy Word64)) + ] + ] + , bgroup "Acc" + [ bgroup "U" + [ bench "Double" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Double)) + , bench "Float" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Float)) + , bench "Int" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Int)) + , bench "Int8" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Int8)) + , bench "Int16" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Int16)) + , bench "Int32" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Int32)) + , bench "Int64" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Int64)) + , bench "Word" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Word)) + , bench "Word8" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Word8)) + , bench "Word16" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Word16)) + , bench "Word32" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Word32)) + , bench "Word64" (makeMWCArray mwc (AMWC.uniform :: DIM1 AMWC.:~> Word64)) + ] + , bgroup "R" + [ bench "Double" (makeMWCArray mwc (AMWC.uniformR (-3.21,26) :: DIM1 AMWC.:~> Double)) + , bench "Float" (makeMWCArray mwc (AMWC.uniformR (-3.21,26) :: DIM1 AMWC.:~> Float)) + , bench "Int" (makeMWCArray mwc (AMWC.uniformR (-12,679) :: DIM1 AMWC.:~> Int)) + , bench "Int8" (makeMWCArray mwc (AMWC.uniformR (-12,4) :: DIM1 AMWC.:~> Int8)) + , bench "Int16" (makeMWCArray mwc (AMWC.uniformR (-12,679) :: DIM1 AMWC.:~> Int16)) + , bench "Int32" (makeMWCArray mwc (AMWC.uniformR (-12,679) :: DIM1 AMWC.:~> Int32)) + , bench "Int64" (makeMWCArray mwc (AMWC.uniformR (-12,679) :: DIM1 AMWC.:~> Int64)) + , bench "Word" (makeMWCArray mwc (AMWC.uniformR (34,633) :: DIM1 AMWC.:~> Word)) + , bench "Word8" (makeMWCArray mwc (AMWC.uniformR (34,63) :: DIM1 AMWC.:~> Word8)) + , bench "Word16" (makeMWCArray mwc (AMWC.uniformR (34,633) :: DIM1 AMWC.:~> Word16)) + , bench "Word32" (makeMWCArray mwc (AMWC.uniformR (34,633) :: DIM1 AMWC.:~> Word32)) + , bench "Word64" (makeMWCArray mwc (AMWC.uniformR (34,633) :: DIM1 AMWC.:~> Word64)) + ] + ] + ] + +{-- + -- SFMT + , bgroup "sfmt" + [ bgroup "U" + [ bench "Double" (whnfIO (SFMT.uniform sfmt :: IO Double)) + , bench "Float" (whnfIO (SFMT.uniform sfmt :: IO Float)) + , bench "Int" (whnfIO (SFMT.uniform sfmt :: IO Int)) + , bench "Int8" (whnfIO (SFMT.uniform sfmt :: IO Int8)) + , bench "Int16" (whnfIO (SFMT.uniform sfmt :: IO Int16)) + , bench "Int32" (whnfIO (SFMT.uniform sfmt :: IO Int32)) + , bench "Int64" (whnfIO (SFMT.uniform sfmt :: IO Int64)) + , bench "Word" (whnfIO (SFMT.uniform sfmt :: IO Word)) + , bench "Word8" (whnfIO (SFMT.uniform sfmt :: IO Word8)) + , bench "Word16" (whnfIO (SFMT.uniform sfmt :: IO Word16)) + , bench "Word32" (whnfIO (SFMT.uniform sfmt :: IO Word32)) + , bench "Word64" (whnfIO (SFMT.uniform sfmt :: IO Word64)) + ] + , bgroup "R" + [ bench "Double" (whnfIO (SFMT.uniformR (-3.21,26) sfmt :: IO Double)) + , bench "Float" (whnfIO (SFMT.uniformR (-3.21,26) sfmt :: IO Float)) + , bench "Int" (whnfIO (SFMT.uniformR (-12,679) sfmt :: IO Int)) + , bench "Int8" (whnfIO (SFMT.uniformR (-12,4) sfmt :: IO Int8)) + , bench "Int16" (whnfIO (SFMT.uniformR (-12,679) sfmt :: IO Int16)) + , bench "Int32" (whnfIO (SFMT.uniformR (-12,679) sfmt :: IO Int32)) + , bench "Int64" (whnfIO (SFMT.uniformR (-12,679) sfmt :: IO Int64)) + , bench "Word" (whnfIO (SFMT.uniformR (34,633) sfmt :: IO Word)) + , bench "Word8" (whnfIO (SFMT.uniformR (34,63) sfmt :: IO Word8)) + , bench "Word16" (whnfIO (SFMT.uniformR (34,633) sfmt :: IO Word16)) + , bench "Word32" (whnfIO (SFMT.uniformR (34,633) sfmt :: IO Word32)) + , bench "Word64" (whnfIO (SFMT.uniformR (34,633) sfmt :: IO Word64)) + ] + , bgroup "Acc" + [ bgroup "U" + [ bench "Double" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Double)) + , bench "Float" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Float)) + , bench "Int" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Int)) + , bench "Int8" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Int8)) + , bench "Int16" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Int16)) + , bench "Int32" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Int32)) + , bench "Int64" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Int64)) + , bench "Word" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Word)) + , bench "Word8" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Word8)) + , bench "Word16" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Word16)) + , bench "Word32" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Word32)) + , bench "Word64" (makeSFMTArray sfmt (ASFMT.uniform :: DIM1 ASFMT.:~> Word64)) + ] + , bgroup "R" + [ bench "Double" (makeSFMTArray sfmt (ASFMT.uniformR (-3.21,26) :: DIM1 ASFMT.:~> Double)) + , bench "Float" (makeSFMTArray sfmt (ASFMT.uniformR (-3.21,26) :: DIM1 ASFMT.:~> Float)) + , bench "Int" (makeSFMTArray sfmt (ASFMT.uniformR (-12,679) :: DIM1 ASFMT.:~> Int)) + , bench "Int8" (makeSFMTArray sfmt (ASFMT.uniformR (-12,4) :: DIM1 ASFMT.:~> Int8)) + , bench "Int16" (makeSFMTArray sfmt (ASFMT.uniformR (-12,679) :: DIM1 ASFMT.:~> Int16)) + , bench "Int32" (makeSFMTArray sfmt (ASFMT.uniformR (-12,679) :: DIM1 ASFMT.:~> Int32)) + , bench "Int64" (makeSFMTArray sfmt (ASFMT.uniformR (-12,679) :: DIM1 ASFMT.:~> Int64)) + , bench "Word" (makeSFMTArray sfmt (ASFMT.uniformR (34,633) :: DIM1 ASFMT.:~> Word)) + , bench "Word8" (makeSFMTArray sfmt (ASFMT.uniformR (34,63) :: DIM1 ASFMT.:~> Word8)) + , bench "Word16" (makeSFMTArray sfmt (ASFMT.uniformR (34,633) :: DIM1 ASFMT.:~> Word16)) + , bench "Word32" (makeSFMTArray sfmt (ASFMT.uniformR (34,633) :: DIM1 ASFMT.:~> Word32)) + , bench "Word64" (makeSFMTArray sfmt (ASFMT.uniformR (34,633) :: DIM1 ASFMT.:~> Word64)) + ] + ] + ] +--} + ] + diff --git a/mwc-random-accelerate.cabal b/mwc-random-accelerate.cabal --- a/mwc-random-accelerate.cabal +++ b/mwc-random-accelerate.cabal @@ -1,20 +1,14 @@ name: mwc-random-accelerate -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Generate Accelerate arrays filled with high quality pseudorandom numbers -description: - Generate /Accelerate/ arrays filled with high-quality pseudorandom numbers. - . - Refer to the main /Accelerate/ package for more information: - - . -tested-with: GHC >= 7.8 - +description: Please see the README on GitHub at +tested-with: GHC >= 8.6 license: BSD3 license-file: LICENSE author: Trevor L. McDonell -maintainer: Trevor L. McDonell +maintainer: Trevor L. McDonell -- copyright: -category: Data +category: Accelerate, Data build-type: Simple -- extra-source-files: cabal-version: >=1.10 @@ -25,18 +19,43 @@ Data.Array.Accelerate.System.Random.MWC build-depends: - base >= 4.7 && < 4.10 - , accelerate >= 0.15 + base >= 4.7 && < 5 + , accelerate >= 1.3 , mwc-random >= 0.8 - ghc-options: -O2 -Wall + ghc-options: + -O2 + -Wall -Source-repository head - Type: git - Location: git://github.com/tmcdonell/mwc-random-accelerate.git +benchmark bench-random + buildable: False -Source-repository this - Type: git - Tag: 0.1.0.0 - Location: git://github.com/tmcdonell/mwc-random-accelerate.git + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + build-depends: + base >= 4.7 && < 5 + , accelerate >= 1.3 + , criterion + , mersenne-random + , mwc-random + , mwc-random-accelerate + , vector + + ghc-options: + -O2 + -rtsopts + + +source-repository head + type: git + location: git://github.com/tmcdonell/mwc-random-accelerate.git + +source-repository this + type: git + tag: v0.2.0.0 + location: git://github.com/tmcdonell/mwc-random-accelerate.git + +-- vim: nospell