{-# LANGUAGE BangPatterns, FlexibleContexts #-}
module Random where
import System.Random.MWC
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Array.IO (MArray, IOUArray)
import Control.Exception (evaluate)
import Data.Array.Accelerate (Z(..),(:.)(..))
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Array.MArray as M
import qualified Data.Array.Accelerate as Acc
-- Convert an Unboxed Data.Array to an Accelerate Array
--
convertUArray :: (IArray UArray e, Acc.Elt e) => UArray Int e -> IO (Acc.Vector e)
convertUArray v =
let arr = Acc.fromIArray v
in evaluate (arr `Acc.indexArray` (Z:.0)) >> return arr
-- Convert a Data.Vector to an Accelerate Array
--
convertVector
:: (IArray UArray a, MArray IOUArray a IO, G.Vector v a, Acc.Elt a)
=> v a
-> IO (Acc.Vector a)
convertVector vec = do
arr <- Acc.fromIArray `fmap` toIArray vec
evaluate (arr `Acc.indexArray` (Z:.0)) >> return arr
where
toIArray :: (MArray IOUArray a IO, IArray UArray a, G.Vector v a) => v a -> IO (UArray Int a)
toIArray v = do
let n = G.length v
mu <- M.newArray_ (0,n-1) :: MArray IOUArray a IO => IO (IOUArray Int a)
let go !i | i < n = M.writeArray mu i (G.unsafeIndex v i) >> go (i+1)
| otherwise = M.unsafeFreeze mu
go 0
-- Generate a random, uniformly distributed vector of specified size over the
-- range. For integral types the range is inclusive, for floating point numbers
-- the range (a,b] is used, if one ignores rounding errors.
--
randomUArrayR
:: (Variate a, MArray IOUArray a IO, IArray UArray a)
=> (a,a)
-> GenIO
-> Int
-> IO (UArray Int a)
randomUArrayR lim gen n = do
mu <- M.newArray_ (0,n-1) :: MArray IOUArray e IO => IO (IOUArray Int e)
let go !i | i < n = uniformR lim gen >>= M.writeArray mu i >> go (i+1)
| otherwise = M.unsafeFreeze mu
go 0
-- Generate a uniformly distributed Data.Vector of specified range and size
--
randomVectorR :: (G.Vector v a, Variate a) => (a,a) -> GenIO -> Int -> IO (v a)
randomVectorR lim gen n = do
mu <- GM.unsafeNew n
let go !i | i < n = uniformR lim gen >>= GM.unsafeWrite mu i >> go (i+1)
| otherwise = G.unsafeFreeze mu
go 0