diff --git a/README.rst b/README.rst --- a/README.rst +++ b/README.rst @@ -37,7 +37,7 @@ * Performance issues: * According to Salmon et al., Threefry-4x64 should be the fastest algorithm on CPUs. - This is what not I'm seeing; need to investigate it further. + This is not what I'm seeing; need to investigate it further. If it is made faster, it should be used as the default bijection for ``CBRNG32/64`` instead of ``philox4``. diff --git a/Random123.cabal b/Random123.cabal --- a/Random123.cabal +++ b/Random123.cabal @@ -1,5 +1,5 @@ Name: Random123 -Version: 0.1.0 +Version: 0.1.1 Synopsis: Haskell port of Random123 library Description: This is a Haskell port of counter-based random number generators from the Random123 library @@ -29,7 +29,7 @@ Source-repository this type: git location: http://github.com/Manticore/haskell-random123.git - tag: 0.1.0 + tag: 0.1.1 Library Exposed-modules: diff --git a/System/Random/Random123.hs b/System/Random/Random123.hs --- a/System/Random/Random123.hs +++ b/System/Random/Random123.hs @@ -60,11 +60,7 @@ threefry4 ) where -import Data.Word -import Data.Bits -import System.Random -import System.Random.Random123.Types import System.Random.Random123.Philox import System.Random.Random123.Threefry import System.Random.Random123.RandomGen diff --git a/System/Random/Random123/RandomGen.hs b/System/Random/Random123/RandomGen.hs --- a/System/Random/Random123/RandomGen.hs +++ b/System/Random/Random123/RandomGen.hs @@ -23,7 +23,6 @@ import System.Random.Random123.Types import System.Random.Random123.Philox -import System.Random.Random123.Threefry -- | 32-bit RNG with a custom bijection function. @@ -55,7 +54,8 @@ then (ctr, wctr + 1) else (increment ctr, 0) -genRange32 = (0, min maxBound (2^32 - 1)) :: (Int, Int) +genRange32 :: (Int, Int) +genRange32 = (0, min maxBound (2^32 - 1)) next64 :: (Counter c, Word64Array c) => (c -> c) -> c -> Int -> (Int, c, Int) next64 bijection ctr wctr = (fromIntegral w64, ctr', wctr') where @@ -65,7 +65,8 @@ then (ctr, wctr + 1) else (increment ctr, 0) -genRange64 = (0, min maxBound (2^64 - 1)) :: (Int, Int) +genRange64 :: (Int, Int) +genRange64 = (0, min maxBound (2^64 - 1)) instance (Counter c, Word32Array c) => RandomGen (CustomCBRNG32 k c) where @@ -73,7 +74,7 @@ (res, ctr', wctr') = next32 (bijection key) ctr wctr new_gen = CustomCBRNG32 bijection key ctr' wctr' genRange _ = genRange32 - split (CustomCBRNG32 bijection key ctr wctr) = (gen', gen'') where + split (CustomCBRNG32 bijection key ctr _) = (gen', gen'') where ctr' = increment ctr ctr'' = bijection key ctr' gen' = CustomCBRNG32 bijection key ctr' 0 @@ -84,7 +85,7 @@ (res, ctr', wctr') = next64 (bijection key) ctr wctr new_gen = CustomCBRNG64 bijection key ctr' wctr' genRange _ = genRange64 - split (CustomCBRNG64 bijection key ctr wctr) = (gen', gen'') where + split (CustomCBRNG64 bijection key ctr _) = (gen', gen'') where ctr' = increment ctr ctr'' = bijection key ctr' gen' = CustomCBRNG64 bijection key ctr' 0 @@ -95,7 +96,7 @@ (res, ctr', wctr') = next32 (philox4 key) ctr wctr new_gen = CBRNG32 key ctr' wctr' genRange _ = genRange32 - split (CBRNG32 key ctr wctr) = (gen', gen'') where + split (CBRNG32 key ctr _) = (gen', gen'') where ctr' = increment ctr ctr'' = philox4 key ctr' gen' = CBRNG32 key ctr' 0 @@ -106,7 +107,7 @@ (res, ctr', wctr') = next64 (philox4 key) ctr wctr new_gen = CBRNG64 key ctr' wctr' genRange _ = genRange64 - split (CBRNG64 key ctr wctr) = (gen', gen'') where + split (CBRNG64 key ctr _) = (gen', gen'') where ctr' = increment ctr ctr'' = philox4 key ctr' gen' = CBRNG64 key ctr' 0 @@ -129,11 +130,11 @@ getState (CBRNG64 key ctr wctr) = CBRNGState (liToInteger key) (liToInteger ctr) wctr instance (LimitedInteger k, LimitedInteger c) => SerializableCBRNG (CustomCBRNG32 k c) where - getState (CustomCBRNG32 bijection key ctr wctr) = + getState (CustomCBRNG32 _ key ctr wctr) = CBRNGState (liToInteger key) (liToInteger ctr) wctr instance (LimitedInteger k, LimitedInteger c) => SerializableCBRNG (CustomCBRNG64 k c) where - getState (CustomCBRNG64 bijection key ctr wctr) = + getState (CustomCBRNG64 _ key ctr wctr) = CBRNGState (liToInteger key) (liToInteger ctr) wctr diff --git a/System/Random/Random123/Threefry.hs b/System/Random/Random123/Threefry.hs --- a/System/Random/Random123/Threefry.hs +++ b/System/Random/Random123/Threefry.hs @@ -9,9 +9,7 @@ import Data.Word import Data.Bits import Data.Array.Base -import Data.Array.Unboxed - import System.Random.Random123.Types import System.Random.Random123.Misc @@ -139,18 +137,19 @@ addTuple4 (k0, k1, k2, k3) (x0, x1, x2, x3) = (k0 + x0, k1 + x1, k2 + x2, k3 + x3) pbox2 :: Bits a => (a, a, a) -> Int -> Array2 a -> Array2 a -pbox2 extended_key r x = (x0', x1' + fromIntegral shift) where - shift = r `div` 4 + 1 - (x0', x1') = addTuple2 x (shiftTuple2 shift extended_key) +pbox2 extended_key r x = (x0', x1' + fromIntegral tshift) where + tshift = r `div` 4 + 1 + (x0', x1') = addTuple2 x (shiftTuple2 tshift extended_key) pbox4 :: Bits a => (a, a, a, a, a) -> Int -> Array4 a -> Array4 a -pbox4 extended_key r x = (x0', x1', x2', x3' + fromIntegral shift) where - shift = r `div` 4 + 1 - (x0', x1', x2', x3') = addTuple4 x (shiftTuple4 shift extended_key) +pbox4 extended_key r x = (x0', x1', x2', x3' + fromIntegral tshift) where + tshift = r `div` 4 + 1 + (x0', x1', x2', x3') = addTuple4 x (shiftTuple4 tshift extended_key) -- Additional helper functions. +threefryRound :: (Int -> c -> c) -> (Int -> c -> c) -> Int -> c -> c threefryRound pbox sbox r x = if r `mod` 4 == 3 then pbox r (sbox r x) else sbox r x diff --git a/System/Random/Random123/Types.hs b/System/Random/Random123/Types.hs --- a/System/Random/Random123/Types.hs +++ b/System/Random/Random123/Types.hs @@ -31,13 +31,13 @@ liBitSize :: a -> Int -array2FromInteger :: Bits a => Integer -> Array2 a +array2FromInteger :: (Num a, Bits a) => Integer -> Array2 a array2FromInteger i = (x0, x1) where x1 = fromInteger i bits = bitSize x1 -- need this because cannot use 'a' type variable x0 = fromInteger (i `shiftR` bits) -array4FromInteger :: Bits a => Integer -> Array4 a +array4FromInteger :: (Num a, Bits a) => Integer -> Array4 a array4FromInteger i = (x0, x1, x2, x3) where x3 = fromInteger i bits = bitSize x3 -- need this because cannot use 'a' type variable @@ -127,33 +127,37 @@ numWords32 :: a -> Int instance Word32Array (Array2 Word32) where - getWord32 0 (x0, x1) = x0 - getWord32 1 (x0, x1) = x1 + getWord32 0 (x0, _) = x0 + getWord32 1 (_, x1) = x1 + getWord32 _ _ = error "Wrong index in getWord32" numWords32 _ = 2 instance Word32Array (Array4 Word32) where - getWord32 0 (x0, x1, x2, x3) = x0 - getWord32 1 (x0, x1, x2, x3) = x1 - getWord32 2 (x0, x1, x2, x3) = x2 - getWord32 3 (x0, x1, x2, x3) = x3 + getWord32 0 (x0, _, _, _) = x0 + getWord32 1 (_, x1, _, _) = x1 + getWord32 2 (_, _, x2, _) = x2 + getWord32 3 (_, _, _, x3) = x3 + getWord32 _ _ = error "Wrong index in getWord32" numWords32 _ = 4 instance Word32Array (Array2 Word64) where - getWord32 0 (x0, x1) = fromIntegral (x0 `shiftR` 32) - getWord32 1 (x0, x1) = fromIntegral x0 - getWord32 2 (x0, x1) = fromIntegral (x1 `shiftR` 32) - getWord32 3 (x0, x1) = fromIntegral x1 + getWord32 0 (x0, _) = fromIntegral (x0 `shiftR` 32) + getWord32 1 (x0, _) = fromIntegral x0 + getWord32 2 (_, x1) = fromIntegral (x1 `shiftR` 32) + getWord32 3 (_, x1) = fromIntegral x1 + getWord32 _ _ = error "Wrong index in getWord32" numWords32 _ = 4 instance Word32Array (Array4 Word64) where - getWord32 0 (x0, x1, x2, x3) = fromIntegral (x0 `shiftR` 32) - getWord32 1 (x0, x1, x2, x3) = fromIntegral x0 - getWord32 2 (x0, x1, x2, x3) = fromIntegral (x1 `shiftR` 32) - getWord32 3 (x0, x1, x2, x3) = fromIntegral x1 - getWord32 4 (x0, x1, x2, x3) = fromIntegral (x2 `shiftR` 32) - getWord32 5 (x0, x1, x2, x3) = fromIntegral x2 - getWord32 6 (x0, x1, x2, x3) = fromIntegral (x3 `shiftR` 32) - getWord32 7 (x0, x1, x2, x3) = fromIntegral x3 + getWord32 0 (x0, _, _, _) = fromIntegral (x0 `shiftR` 32) + getWord32 1 (x0, _, _, _) = fromIntegral x0 + getWord32 2 (_, x1, _, _) = fromIntegral (x1 `shiftR` 32) + getWord32 3 (_, x1, _, _) = fromIntegral x1 + getWord32 4 (_, _, x2, _) = fromIntegral (x2 `shiftR` 32) + getWord32 5 (_, _, x2, _) = fromIntegral x2 + getWord32 6 (_, _, _, x3) = fromIntegral (x3 `shiftR` 32) + getWord32 7 (_, _, _, x3) = fromIntegral x3 + getWord32 _ _ = error "Wrong index in getWord32" numWords32 _ = 8 @@ -169,25 +173,29 @@ getWord64 0 (x0, x1) = hi `shiftL` 32 + lo where lo = fromIntegral x1 :: Word64 hi = fromIntegral x0 :: Word64 + getWord64 _ _ = error "Wrong index in getWord64" numWords64 _ = 1 instance Word64Array (Array4 Word32) where - getWord64 0 (x0, x1, x2, x3) = hi `shiftL` 32 + lo where + getWord64 0 (x0, x1, _, _) = hi `shiftL` 32 + lo where lo = fromIntegral x1 :: Word64 hi = fromIntegral x0 :: Word64 - getWord64 1 (x0, x1, x2, x3) = hi `shiftL` 32 + lo where + getWord64 1 (_, _, x2, x3) = hi `shiftL` 32 + lo where lo = fromIntegral x2 :: Word64 hi = fromIntegral x3 :: Word64 + getWord64 _ _ = error "Wrong index in getWord64" numWords64 _ = 2 instance Word64Array (Array2 Word64) where - getWord64 0 (x0, x1) = x0 - getWord64 1 (x0, x1) = x1 + getWord64 0 (x0, _) = x0 + getWord64 1 (_, x1) = x1 + getWord64 _ _ = error "Wrong index in getWord64" numWords64 _ = 2 instance Word64Array (Array4 Word64) where - getWord64 0 (x0, x1, x2, x3) = x0 - getWord64 1 (x0, x1, x2, x3) = x1 - getWord64 2 (x0, x1, x2, x3) = x2 - getWord64 3 (x0, x1, x2, x3) = x3 + getWord64 0 (x0, _, _, _) = x0 + getWord64 1 (_, x1, _, _) = x1 + getWord64 2 (_, _, x2, _) = x2 + getWord64 3 (_, _, _, x3) = x3 + getWord64 _ _ = error "Wrong index in getWord64" numWords64 _ = 4 diff --git a/test/TestRandomGen.hs b/test/TestRandomGen.hs --- a/test/TestRandomGen.hs +++ b/test/TestRandomGen.hs @@ -1,15 +1,13 @@ -- | Test standard RandomGen interface of Random123-backed generators. module TestRandomGen (test_randomgen) where -import Data.Word import System.Random import Test.Framework (testGroup) import Test.Framework.Providers.HUnit import Test.HUnit -import System.Random.Random123.Types -import System.Random.Random123.RandomGen +import System.Random.Random123 -- Expected mean and standard deviation for a list of uniformly distributed random floats diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -12,4 +12,5 @@ test_randomgen ] +main :: IO () main = defaultMain tests