packages feed

Random123 (empty) → 0.1.0

raw patch · 20 files changed

+1447/−0 lines, 20 filesdep +HUnitdep +QuickCheckdep +Random123setup-changed

Dependencies added: HUnit, QuickCheck, Random123, array, base, criterion, random, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013--inf, Bogdan Opanchuk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Bogdan Opanchuk nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.rst view
@@ -0,0 +1,57 @@+Random123+=========++This is a Haskell port of counter-based random number generators from `Random123 library <http://www.thesalmons.org/john/random123/>`_ v1.07 (with a minor bugfix).+The description of algorithms can be also found in `Salmon et al., P. Int. C. High. Perform. 16 (2011) <http://dx.doi.org/doi:10.1145/2063384.2063405>`_.+++Contributing+------------++When making changes to the library, run (or update, if necessary) functionality tests.+This can be done as++::++    $ cabal configure --enable-tests+    $ cabal build+    $ cabal test++or just by executing ``cd test; ./test.sh``.+You can also check the performance by running benchmarks as++::++    $ cabal configure --enable-benchmarks+    $ cabal build+    $ cabal bench++or by executing ``cd test; ./test_perf.sh``.+Benchmarks will create a report file ``test_perf.html``+in the folder where they were executed from.+++TODO+----++* 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.+      If it is made faster, it should be used as the default bijection for ``CBRNG32/64``+      instead of ``philox4``.++    * ``mulhilo`` function in 64-bit Philox is not optimal in terms of performance.+      It can be made faster given the access to CPU intrinsics.++    * 32-bit Threefry shows suprisingly low performance (see ``Bijection`` benchmark group).++    * In general, there seems to be a lot of optimizations that can be done,+      in particular in terms of strategically placed strictness enforcement.++* Current ``split`` implementation is a quick solution that kind of works+  (much like ``StdGen``'s one).+  A mathematically robust implementation is required+  (and CBRNGs by nature should be well-suited for this).+  Moreover, it would be great to have some tests that could distinguish+  "bad" ``split`` from a "good" one.
+ Random123.cabal view
@@ -0,0 +1,72 @@+Name:                Random123+Version:             0.1.0+Synopsis:            Haskell port of Random123 library+Description:+  This is a Haskell port of counter-based random number generators from the Random123 library+  (<http://www.thesalmons.org/john/random123/>) v1.07 (with a minor bugfix).+  The description of algorithms can be also found in+  Salmon et al., P. Int. C. High. Perform. 16 (2011)+  (<http://dx.doi.org/doi:10.1145/2063384.2063405>).++Homepage:            http://github.com/Manticore/haskell-random123+License:             MIT+License-file:        LICENSE+Author:              Bogdan Opanchuk <bogdan@opanchuk.net>+Maintainer:          Bogdan Opanchuk <bogdan@opanchuk.net>+Category:            Random+Build-type:          Simple+Cabal-version:       >=1.8++Extra-source-files:+  README.rst+  test/*.sh++Source-repository head+  type:     git+  location: http://github.com/Manticore/haskell-random123.git+  branch:   develop++Source-repository this+  type:     git+  location: http://github.com/Manticore/haskell-random123.git+  tag:      0.1.0++Library+  Exposed-modules:+    System.Random.Random123+    System.Random.Random123.Misc+    System.Random.Random123.Threefry+    System.Random.Random123.Philox+    System.Random.Random123.Types+    System.Random.Random123.RandomGen++  Build-Depends:+    base >= 4.4.0.0 && < 5.0,+    array >= 0.4,+    random >= 1.0.0.0++Test-Suite test+  Type: exitcode-stdio-1.0+  Hs-source-dirs: test+  Main-is: test.hs+  Other-modules: TestPhilox TestThreefry TestRandomGen TestTypeclasses+  Build-depends:+    base >= 4.4 && < 5.0,+    random >= 1.0,+    test-framework >= 0.8,+    test-framework-hunit >= 0.3,+    test-framework-quickcheck2 >= 0.3,+    HUnit >= 1.2,+    QuickCheck >= 2.5,+    Random123++Benchmark test_perf+  Type: exitcode-stdio-1.0+  Hs-source-dirs: test+  Main-is: test_perf.hs+  Build-depends:+    base >= 4.4 && < 5.0,+    random >= 1.0,+    criterion >= 0.6,+    Random123+  Ghc-options: -O2
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Random/Random123.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleInstances #-}++-- | This module is a Haskell port of the Random123 library+-- (<http://www.thesalmons.org/john/random123/>).+-- It is based on counter-based pseudo-random number generators (CBRNGs), which are, essentially,+-- keyed bijections which transform successive counters into randomly distributed integers.+-- For details about the theory behind the algorithms along with statistical and performance tests+-- see the paper Salmon et al., P. Int. C. High. Perform. 16 (2011)+-- (<http://dx.doi.org/doi:10.1145/2063384.2063405>).+--+-- The module exposes both bijection functions themselves (for customized approach) and+-- instances of 'RandomGen'.+--+-- Since CBRNGs are based on bijection functions, their periods are equal to the size of their+-- corresponding counters.+-- For example, 32-bit 'philox4' has 'Array4' 'Word32' counter,+-- therefore the total counter size is @4 * 32 = 128@ bit, and the period is @2^128@.+--+-- 'RandomGen' instances use each generated random array for several random integers,+-- so their periods are several times bigger.+-- Consider now that the 'philox4' bijection was used to create a 'CustomCBRNG64' generator.+-- For each 64-bit 'Int' its 'next' function returns,+-- it will use two of the elements of the 'Array4' 'Word32',+-- so the total period is @2 * 2^128 = 2^129@.+--+-- /Note:/ There is no point in creating 64-bit RNGs when your platform has only 32-bit 'Int's.+-- The remaining bits will be truncated by 'next'.+module System.Random.Random123 (+    -- * Default RNGs+    -- | Use these if you want the (usually) optimal bijection algorithm,+    -- and serialization capabilities.+    CBRNG32,+    mkCBRNG32,+    restoreCBRNG32,+    CBRNG64,+    mkCBRNG64,+    restoreCBRNG64,++    -- * Custom RNGs+    -- | Use these if you want a custom bijection algorithm.+    CustomCBRNG32,+    mkCustomCBRNG32,+    restoreCustomCBRNG32,+    CustomCBRNG64,+    mkCustomCBRNG64,+    restoreCustomCBRNG64,++    -- * Keyed bijection functions+    -- | Use these if you want the ultimate control over keys and counters.+    -- Sometimes it is advantageous to bind part of the counter or the key+    -- the node or thread identifier, or to indices of a time or space grid.+    -- You can use 'liFromInteger' (or just a tuple constructor) to create keys and counters,+    -- and 'skip' and 'increment' to change counter values.+    --+    -- If you want further control over the number of rounds in these bijections,+    -- see "System.Random.Random123.Philox" and "System.Random.Random123.Threefry" modules.+    philox2,+    philox4,+    threefry2,+    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
+ System/Random/Random123/Misc.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_HADDOCK hide #-}++-- | Miscellaneous helper functions.+module System.Random.Random123.Misc where+++-- | Apply a function to its result sequentially,+--   additionally passing it the current iteration number.+apply :: (Int -> a -> a) -> Int -> a -> a+apply f n = applyLoop 0 where+    applyLoop i v+        | i == n = v+        | otherwise = applyLoop (i + 1) $! f i v++-- | Apply a function to its result sequentially.+apply_ :: (a -> a) -> Int -> a -> a+apply_ f = apply (\_ v -> f v)
+ System/Random/Random123/Philox.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK not-home #-}++-- | Philox, a counter-based random number generator (keyed bijection function).+-- Characterized by a low number of rounds involving relatively expensive computations.+module System.Random.Random123.Philox (+    philox2, philox4, philox2R, philox4R, PhiloxWord) where++import Data.Word+import Data.Bits++import System.Random.Random123.Misc+import System.Random.Random123.Types+++-- | Class of integer types suitable for use in Philox algorithm.+class (Bits a, Num a) => PhiloxWord a where+    mulhilo :: a -> a -> Array2 a+    philoxW_0 :: a+    philoxW_1 :: a+    philoxM2 :: a+    philoxM4_0 :: a+    philoxM4_1 :: a+++instance PhiloxWord Word32 where+    mulhilo a b = (hi, lo) where+        r :: Word64+        r = fromIntegral a * fromIntegral b+        hi = fromIntegral (r `shiftR` 32)+        lo = fromIntegral r++    philoxW_0 = 0x9E3779B9 -- golden ratio+    philoxW_1 = 0xBB67AE85 -- sqrt(3)-1++    philoxM2 = 0xD256D193++    -- The order is swapped as compared to the reference implementation,+    -- to make the call order in philoxRound4 more logical.+    philoxM4_0 = 0xCD9E8D57+    philoxM4_1 = 0xD2511F53+++instance PhiloxWord Word64 where+    mulhilo a b = (hi, lo) where+        r :: Integer+        r = fromIntegral a * fromIntegral b+        hi = fromIntegral (r `shiftR` 64)+        lo = fromIntegral r++    philoxW_0 = 0x9E3779B97F4A7C15 -- golden ratio+    philoxW_1 = 0xBB67AE8584CAA73B -- sqrt(3)-1++    philoxM2 = 0xD2B74407B1CE6E93++    -- The order is swapped as compared to the reference implementation,+    -- to make the call order in philoxRound4 more logical.+    philoxM4_0 = 0xCA5A826395121157+    philoxM4_1 = 0xD2E7470EE14C6C93+++philoxSubround :: PhiloxWord a => Int -> a -> a -> a -> Array2 a -> Array2 a+philoxSubround r w m k (x0, x1) = (x0', x1') where+    k' = k + w * fromIntegral r+    (hi, lo) = mulhilo m x0+    x0' = hi `xor` k' `xor` x1+    x1' = lo++-- FIXME: For some reason, if I do not force strictness in x0 and x1 here, it eats up the stack.+philoxRound2 :: PhiloxWord a => a -> Int -> Array2 a -> Array2 a+philoxRound2 k r (!x0, !x1) = (x0', x1') where+    (x0', x1') = philoxSubround r philoxW_0 philoxM2 k (x0, x1)++-- FIXME: For some reason, if I do not force strictness in x0-x3 here, it eats up the stack.+philoxRound4 :: PhiloxWord a => Array2 a -> Int -> Array4 a -> Array4 a+philoxRound4 (k0, k1) r (!x0, !x1, !x2, !x3) = (x0', x1', x2', x3') where+    (x0', x1') = philoxSubround r philoxW_0 philoxM4_0 k0 (x2, x1)+    (x2', x3') = philoxSubround r philoxW_1 philoxM4_1 k1 (x0, x3)+++-- | Generates a Philox-2 random number with a custom number of rounds.+philox2R :: PhiloxWord a+    => Int -- ^ number of rounds (1-16),+    -> a -- ^ key,+    -> Array2 a -- ^ counter,+    -> Array2 a -- ^ random number.+philox2R rounds key ctr+    | (rounds >= 1) && (rounds <= 16) = apply (philoxRound2 key) rounds ctr+    | otherwise = error "The number of rounds in Philox-2 must be between 1 and 16"+++-- | Generates a Philox-4 random number with a custom number of rounds.+philox4R :: PhiloxWord a+    => Int -- ^ number of rounds (1-16),+    -> Array2 a -- ^ key,+    -> Array4 a -- ^ counter,+    -> Array4 a -- ^ random number.+philox4R rounds key ctr+    | (rounds >= 1) && (rounds <= 16) = apply (philoxRound4 key) rounds ctr+    | otherwise = error "The number of rounds in Philox-4 must be between 1 and 16"+++-- | Generates a Philox-2 random number with the optimal number of rounds.+philox2 :: PhiloxWord a+    => a -- ^ key,+    -> Array2 a -- ^ counter,+    -> Array2 a -- ^ random number.+philox2 = philox2R 10+++-- | Generates a Philox-4 random number with the optimal number of rounds.+philox4 :: PhiloxWord a+    => Array2 a -- ^ key,+    -> Array4 a -- ^ counter,+    -> Array4 a -- ^ random number.+philox4 = philox4R 10
+ System/Random/Random123/RandomGen.hs view
@@ -0,0 +1,180 @@+{-# OPTIONS_HADDOCK not-home #-}++-- | Integration with the standard library 'RandomGen' class.+module System.Random.Random123.RandomGen (+    mkCustomCBRNG32,+    mkCustomCBRNG64,+    restoreCustomCBRNG32,+    restoreCustomCBRNG64,+    mkCBRNG32,+    mkCBRNG64,+    restoreCBRNG32,+    restoreCBRNG64,+    CBRNG32,+    CBRNG64,+    CustomCBRNG32,+    CustomCBRNG64,+    CBRNGState,+    SerializableCBRNG(..)+    ) where++import System.Random+import Data.Word++import System.Random.Random123.Types+import System.Random.Random123.Philox+import System.Random.Random123.Threefry+++-- | 32-bit RNG with a custom bijection function.+-- Can be serialized with 'getState' and restored with 'restoreCustomCBRNG32'+-- (but it is the user's responsibility to provide the original bijection).+data CustomCBRNG32 k c = CustomCBRNG32 (k -> c -> c) k c Int++-- | 64-bit RNG with a custom bijection function.+-- Can be serialized with 'getState' and restored with 'restoreCustomCBRNG32'+-- (but it is the user's responsibility to provide the original bijection).+data CustomCBRNG64 k c = CustomCBRNG64 (k -> c -> c) k c Int++-- | Default 32-bit RNG.+-- Supports serialization through 'Show' / 'Read' interface.+-- Alternatively, can be serialized with 'getState' and restored with 'restoreCBRNG32'.+data CBRNG32 = CBRNG32 (Array2 Word32) (Array4 Word32) Int deriving (Eq, Show, Read)++-- | Default 64-bit RNG.+-- Supports serialization through 'Show' / 'Read' interface.+-- Alternatively, can be serialized with 'getState' and restored with 'restoreCBRNG64'.+data CBRNG64 = CBRNG64 (Array2 Word64) (Array4 Word64) Int deriving (Eq, Show, Read)+++next32 :: (Counter c, Word32Array c) => (c -> c) -> c -> Int -> (Int, c, Int)+next32 bijection ctr wctr = (fromIntegral w32, ctr', wctr') where+    arr = bijection ctr+    w32 = getWord32 wctr arr+    (ctr', wctr') = if wctr + 1 < numWords32 arr+        then (ctr, wctr + 1)+        else (increment ctr, 0)++genRange32 = (0, min maxBound (2^32 - 1)) :: (Int, Int)++next64 :: (Counter c, Word64Array c) => (c -> c) -> c -> Int -> (Int, c, Int)+next64 bijection ctr wctr = (fromIntegral w64, ctr', wctr') where+    arr = bijection ctr+    w64 = getWord64 wctr arr+    (ctr', wctr') = if wctr + 1 < numWords64 arr+        then (ctr, wctr + 1)+        else (increment ctr, 0)++genRange64 = (0, min maxBound (2^64 - 1)) :: (Int, Int)+++instance (Counter c, Word32Array c) => RandomGen (CustomCBRNG32 k c) where+    next (CustomCBRNG32 bijection key ctr wctr) = (res, new_gen) where+        (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+        ctr' = increment ctr+        ctr'' = bijection key ctr'+        gen' = CustomCBRNG32 bijection key ctr' 0+        gen'' = CustomCBRNG32 bijection key ctr'' 0++instance (Counter c, Word64Array c) => RandomGen (CustomCBRNG64 k c) where+    next (CustomCBRNG64 bijection key ctr wctr) = (res, new_gen) where+        (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+        ctr' = increment ctr+        ctr'' = bijection key ctr'+        gen' = CustomCBRNG64 bijection key ctr' 0+        gen'' = CustomCBRNG64 bijection key ctr'' 0++instance RandomGen CBRNG32 where+    next (CBRNG32 key ctr wctr) = (res, new_gen) where+        (res, ctr', wctr') = next32 (philox4 key) ctr wctr+        new_gen = CBRNG32 key ctr' wctr'+    genRange _ = genRange32+    split (CBRNG32 key ctr wctr) = (gen', gen'') where+        ctr' = increment ctr+        ctr'' = philox4 key ctr'+        gen' = CBRNG32 key ctr' 0+        gen'' = CBRNG32 key ctr'' 0++instance RandomGen CBRNG64 where+    next (CBRNG64 key ctr wctr) = (res, new_gen) where+        (res, ctr', wctr') = next64 (philox4 key) ctr wctr+        new_gen = CBRNG64 key ctr' wctr'+    genRange _ = genRange64+    split (CBRNG64 key ctr wctr) = (gen', gen'') where+        ctr' = increment ctr+        ctr'' = philox4 key ctr'+        gen' = CBRNG64 key ctr' 0+        gen'' = CBRNG64 key ctr'' 0++-- | Generalized CBRNG state, consisting of key, counter and subcounter,+-- where the first two are cast to integers (using 'liToInteger').+data CBRNGState = CBRNGState Integer Integer Int deriving (Eq, Show, Read)+++-- | Class of RNGs allowing the state extraction.+class SerializableCBRNG a where+    getState :: a -> CBRNGState+++instance SerializableCBRNG CBRNG32 where+    getState (CBRNG32 key ctr wctr) = CBRNGState (liToInteger key) (liToInteger ctr) wctr++instance SerializableCBRNG CBRNG64 where+    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) =+        CBRNGState (liToInteger key) (liToInteger ctr) wctr++instance (LimitedInteger k, LimitedInteger c) => SerializableCBRNG (CustomCBRNG64 k c) where+    getState (CustomCBRNG64 bijection key ctr wctr) =+        CBRNGState (liToInteger key) (liToInteger ctr) wctr+++-- | Creates a custom 32-bit RNG from a keyed bijection+-- ('Word32'- or 'Word64'-parametrized version of 'philox2', 'philox2R', 'philox4', 'philox4R',+-- 'threefry2', 'threefry2R', 'threefry4', 'threefry4R')+-- and a corresponding key.+mkCustomCBRNG32 :: LimitedInteger c => (k -> c -> c) -> k -> CustomCBRNG32 k c+mkCustomCBRNG32 bijection key = CustomCBRNG32 bijection key (liFromInteger 0) 0++-- | Restores a custom 32-bit RNG from a saved state.+restoreCustomCBRNG32 :: (LimitedInteger k, LimitedInteger c)+    => (k -> c -> c) -> CBRNGState -> CustomCBRNG32 k c+restoreCustomCBRNG32 bijection (CBRNGState key ctr wctr) =+    CustomCBRNG32 bijection (liFromInteger key) (liFromInteger ctr) wctr++-- | Creates a custom 64-bit RNG from a keyed bijection+-- ('Word32'- or 'Word64'-parametrized version of 'philox2', 'philox2R', 'philox4', 'philox4R',+-- 'threefry2', 'threefry2R', 'threefry4', 'threefry4R')+-- and a corresponding key.+mkCustomCBRNG64 :: LimitedInteger c => (k -> c -> c) -> k -> CustomCBRNG64 k c+mkCustomCBRNG64 bijection key = CustomCBRNG64 bijection key (liFromInteger 0) 0++-- | Restores a custom 64-bit RNG from a saved state.+restoreCustomCBRNG64 :: (LimitedInteger k, LimitedInteger c)+    => (k -> c -> c) -> CBRNGState -> CustomCBRNG64 k c+restoreCustomCBRNG64 bijection (CBRNGState key ctr wctr) =+    CustomCBRNG64 bijection (liFromInteger key) (liFromInteger ctr) wctr++-- | Creates a default 32-bit RNG (based on 32-bit 'philox4') with an 'Integer' key.+mkCBRNG32 :: Integer -> CBRNG32+mkCBRNG32 key = CBRNG32 (liFromInteger key) (liFromInteger 0) 0++-- | Restores a default 32-bit RNG from a saved state.+restoreCBRNG32 :: CBRNGState -> CBRNG32+restoreCBRNG32 (CBRNGState key ctr wctr) = CBRNG32 (liFromInteger key) (liFromInteger ctr) wctr++-- | Creates a default 64-bit RNG (based on 64-bit 'philox4') with an 'Integer' key.+mkCBRNG64 :: Integer -> CBRNG64+mkCBRNG64 key = CBRNG64 (liFromInteger key) (liFromInteger 0) 0++-- | Restores a default 64-bit RNG from a saved state.+restoreCBRNG64 :: CBRNGState -> CBRNG64+restoreCBRNG64 (CBRNGState key ctr wctr) = CBRNG64 (liFromInteger key) (liFromInteger ctr) wctr
+ System/Random/Random123/Threefry.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK not-home #-}++-- | Threefry, a counter-based random number generator (keyed bijection function).+-- Characterized by a high number of rounds involving relatively cheap computations.+module System.Random.Random123.Threefry (+    threefry2, threefry4, threefry2R, threefry4R, ThreefryWord) where++import Data.Word+import Data.Bits+import Data.Array.Base+import Data.Array.Unboxed+++import System.Random.Random123.Types+import System.Random.Random123.Misc+++-- Helper type to store small constant arrays of rotation constants,+-- and accompanying function for their extraction.+-- Not sure if UArray and unsafeAt are the best choice.++type RotationConstants = UArray Int Int++getRotationConstant :: RotationConstants -> Int -> Int+getRotationConstant = unsafeAt+++-- | Class of integer types suitable for use in Threefry algorithm.+class ThreefryWord a where+    parityConstant :: a+    rotationConstant2 :: a -> RotationConstants+    rotationConstant4_0 :: a -> RotationConstants+    rotationConstant4_1 :: a -> RotationConstants+++instance ThreefryWord Word32 where+    parityConstant = 0x1BD11BDA++    -- Output from skein_rot_search (srs32x2-X5000.out)+    -- Random seed = 1. BlockSize = 64 bits. sampleCnt =  1024. rounds =  8, minHW_or=28+    -- Start: Tue Jul 12 11:11:33 2011+    -- rMin = 0.334. #0206[*07] [CRC=1D9765C0. hw_OR=32. cnt=16384. blkSize=  64].format+    -- 4 rounds: minHW =  4  [  4  4  4  4 ]+    -- 5 rounds: minHW =  6  [  6  8  6  8 ]+    -- 6 rounds: minHW =  9  [  9 12  9 12 ]+    -- 7 rounds: minHW = 16  [ 16 24 16 24 ]+    -- 8 rounds: minHW = 32  [ 32 32 32 32 ]+    -- 9 rounds: minHW = 32  [ 32 32 32 32 ]+    -- 10 rounds: minHW = 32  [ 32 32 32 32 ]+    -- 11 rounds: minHW = 32  [ 32 32 32 32 ]+    rotationConstant2 _ = listArray (0, 7) [13, 15, 26, 6, 17, 29, 16, 24]++    -- Output from skein_rot_search: (srs-B128-X5000.out)+    -- Random seed = 1. BlockSize = 64 bits. sampleCnt =  1024. rounds =  8, minHW_or=28+    -- Start: Mon Aug 24 22:41:36 2009+    -- ...+    -- rMin = 0.472. #0A4B[*33] [CRC=DD1ECE0F. hw_OR=31. cnt=16384. blkSize= 128].format+    -- 4 rounds: minHW =  3  [  3  3  3  3 ]+    -- 5 rounds: minHW =  7  [  7  7  7  7 ]+    -- 6 rounds: minHW = 12  [ 13 12 13 12 ]+    -- 7 rounds: minHW = 22  [ 22 23 22 23 ]+    -- 8 rounds: minHW = 31  [ 31 31 31 31 ]+    -- 9 rounds: minHW = 32  [ 32 32 32 32 ]+    -- 10 rounds: minHW = 32  [ 32 32 32 32 ]+    -- 11 rounds: minHW = 32  [ 32 32 32 32 ]+    rotationConstant4_0 _ = listArray (0, 7) [10, 11, 13, 23, 6, 17, 25, 18]+    rotationConstant4_1 _ = listArray (0, 7) [26, 21, 27, 5, 20, 11, 10, 20]+++instance ThreefryWord Word64 where+    parityConstant = 0x1BD11BDAA9FC1A22++    -- Output from skein_rot_search: (srs64_B64-X1000)+    -- Random seed = 1. BlockSize = 128 bits. sampleCnt =  1024. rounds =  8, minHW_or=57+    -- Start: Tue Mar  1 10:07:48 2011+    -- rMin = 0.136. #0325[*15] [CRC=455A682F. hw_OR=64. cnt=16384. blkSize= 128].format+    -- 4 rounds: minHW =  4  [  4  4  4  4 ]+    -- 5 rounds: minHW =  8  [  8  8  8  8 ]+    -- 6 rounds: minHW = 16  [ 16 16 16 16 ]+    -- 7 rounds: minHW = 32  [ 32 32 32 32 ]+    -- 8 rounds: minHW = 64  [ 64 64 64 64 ]+    -- 9 rounds: minHW = 64  [ 64 64 64 64 ]+    -- 10 rounds: minHW = 64  [ 64 64 64 64 ]+    -- 11 rounds: minHW = 64  [ 64 64 64 64 ]+    rotationConstant2 _ = listArray (0, 7) [16, 42, 12, 31, 16, 32, 24, 21]++    -- These are the R_256 constants from the Threefish reference sources+    -- with names changed to R_64x4...+    rotationConstant4_0 _ = listArray (0, 7) [14, 52, 23, 5, 25, 46, 58, 32]+    rotationConstant4_1 _ = listArray (0, 7) [16, 57, 40, 37, 33, 12, 22, 32]+++-- S-box++-- FIXME: For some reason, if I do not force strictness in x0 and x1 here, it eats up the stack.+sbox' :: Bits a => Int -> (a -> RotationConstants) -> Array2 a -> Array2 a+sbox' r r_constant (!x0, !x1) = (x0', x1') where+    rot = getRotationConstant (r_constant (undefined :: a)) (r `mod` 8)+    x0' = x0 + x1+    x1' = x0' `xor` (x1 `rotate` rot)++sbox2 :: (ThreefryWord a, Bits a) => Int -> Array2 a -> Array2 a+sbox2 r = sbox' r rotationConstant2++-- FIXME: For some reason, if I do not force strictness in x0-x3 here, it eats up the stack.+sbox4 :: (ThreefryWord a, Bits a) => Int -> Array4 a -> Array4 a+sbox4 r (!x0, !x1, !x2, !x3) = (x0', x1', x2', x3') where+    (xa, xb) = if r `mod` 2 == 0 then (x1, x3) else (x3, x1)+    (x0', xa') = sbox' r rotationConstant4_0 (x0, xa)+    (x2', xb') = sbox' r rotationConstant4_1 (x2, xb)+    (x1', x3') = if r `mod` 2 == 0 then (xa', xb') else (xb', xa')+++-- P-box++shiftTuple2 :: Int -> (a, a, a) -> Array2 a+shiftTuple2 i (k0, k1, k2)+    | remainder == 0 = (k0, k1)+    | remainder == 1 = (k1, k2)+    | otherwise = (k2, k0)+    where+        remainder = i `mod` 3++shiftTuple4 :: Int -> (a, a, a, a, a) -> Array4 a+shiftTuple4 i (k0, k1, k2, k3, k4)+    | remainder == 0 = (k0, k1, k2, k3)+    | remainder == 1 = (k1, k2, k3, k4)+    | remainder == 2 = (k2, k3, k4, k0)+    | remainder == 3 = (k3, k4, k0, k1)+    | otherwise = (k4, k0, k1, k2)+    where+        remainder = i `mod` 5++addTuple2 :: Num a => Array2 a -> Array2 a -> Array2 a+addTuple2 (k0, k1) (x0, x1) = (k0 + x0, k1 + x1)++addTuple4 :: Num a => Array4 a -> Array4 a -> Array4 a+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)++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)+++-- Additional helper functions.++threefryRound pbox sbox r x = if r `mod` 4 == 3+    then pbox r (sbox r x)+    else sbox r x++extendKey2 :: (ThreefryWord a, Bits a) => Array2 a -> (a, a, a)+extendKey2 (k0, k1) = (k0, k1, k0 `xor` k1 `xor` parityConstant)++extendKey4 :: (ThreefryWord a, Bits a) => Array4 a -> (a, a, a, a, a)+extendKey4 (k0, k1, k2, k3) = (k0, k1, k2, k3, k0 `xor` k1 `xor` k2 `xor` k3 `xor` parityConstant)+++-- | Generates a Threefry-2 random number with a custom number of rounds.+threefry2R :: (ThreefryWord a, Bits a)+    => Int -- ^ number of rounds (1-32),+    -> Array2 a -- ^ key,+    -> Array2 a -- ^ counter,+    -> Array2 a -- ^ random number.+threefry2R rounds key ctr+    | (rounds >= 1) && (rounds <= 32) = apply (threefryRound pbox sbox2) rounds starting_x+    | otherwise = error "The number of rounds in Threefry-2 must be between 1 and 32"+    where+        starting_x = addTuple2 key ctr+        pbox = pbox2 (extendKey2 key)+++-- | Generates a Threefry-4 random number with a custom number of rounds.+threefry4R :: (ThreefryWord a, Bits a)+    => Int -- ^ number of rounds (1-72),+    -> Array4 a -- ^ key,+    -> Array4 a -- ^ counter,+    -> Array4 a -- ^ random number.+threefry4R rounds key ctr+    | (rounds >= 1) && (rounds <= 72) = apply (threefryRound pbox sbox4) rounds starting_x+    | otherwise = error "The number of rounds in Threefry-4 must be between 1 and 72"+    where+        starting_x = addTuple4 key ctr+        pbox = pbox4 (extendKey4 key)+++-- | Generates a Threefry-2 random number with the optimal number of rounds.+threefry2 :: (ThreefryWord a, Bits a)+    => Array2 a -- ^ key,+    -> Array2 a -- ^ counter,+    -> Array2 a -- ^ random number.+threefry2 = threefry2R 20+++-- | Generates a Threefry-4 random number with the optimal number of rounds.+threefry4 :: (ThreefryWord a, Bits a)+    => Array4 a -- ^ key,+    -> Array4 a -- ^ counter,+    -> Array4 a -- ^ random number.+threefry4 = threefry4R 20
+ System/Random/Random123/Types.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}++-- | Type synonyms and type classes for use in function and instance declarations.+module System.Random.Random123.Types (+    Array2,+    Array4,+    LimitedInteger(..),+    Counter(..),+    Word32Array(..),+    Word64Array(..)+    ) where++import Data.Bits+import Data.Word++-- | Type synonym for a 2-element array.+type Array2 a = (a, a)++-- | Type synonym for a 4-element array.+type Array4 a = (a, a, a, a)+++-- | Class of integers with more bits than in simple types yet having fixed limited size+-- (unlike the built-in 'Integer').+class LimitedInteger a where+    -- | Creates an instance from an 'Integer' (which is truncated by modulus @2^'liBitSize'@).+    liFromInteger :: Integer -> a+    -- | Creates an 'Integer' in range @[0, 2^'liBitSize')@ from an instance.+    liToInteger :: a -> Integer+    -- | Returns the size of the information in the array.+    liBitSize :: a -> Int+++array2FromInteger :: 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 i = (x0, x1, x2, x3) where+    x3 = fromInteger i+    bits = bitSize x3 -- need this because cannot use 'a' type variable+    x0 = fromInteger (i `shiftR` (bits * 3))+    x1 = fromInteger (i `shiftR` (bits * 2))+    x2 = fromInteger (i `shiftR` bits)++array2ToInteger :: (Integral a, Bits a) => Array2 a -> Integer+array2ToInteger (x0, x1) = x0' + x1' where+    bits = bitSize x0+    x0' = toInteger x0 `shiftL` bits+    x1' = toInteger x1++array4ToInteger :: (Integral a, Bits a) => Array4 a -> Integer+array4ToInteger (x0, x1, x2, x3) = x0' + x1' + x2' + x3' where+    bits = bitSize x0+    x0' = toInteger x0 `shiftL` (bits * 3)+    x1' = toInteger x1 `shiftL` (bits * 2)+    x2' = toInteger x2 `shiftL` bits+    x3' = toInteger x3++-- Technically, Word32 and Word64 instances are identical,+-- but I couldn't persuade GHC to compile them in generalized form+-- (like "instance (Num a, Bits a, Integral a) => LimitedInteger (Array2 a)").++instance LimitedInteger Word32 where+    liFromInteger = fromInteger+    liToInteger = toInteger+    liBitSize = bitSize++instance LimitedInteger (Array2 Word32) where+    liFromInteger = array2FromInteger+    liToInteger = array2ToInteger+    liBitSize _ = bitSize (undefined :: Word32) * 2++instance LimitedInteger (Array4 Word32) where+    liFromInteger = array4FromInteger+    liToInteger = array4ToInteger+    liBitSize _ = bitSize (undefined :: Word32) * 4+++instance LimitedInteger Word64 where+    liFromInteger = fromInteger+    liToInteger = toInteger+    liBitSize = bitSize++instance LimitedInteger (Array2 Word64) where+    liFromInteger = array2FromInteger+    liToInteger = array2ToInteger+    liBitSize _ = bitSize (undefined :: Word64) * 2++instance LimitedInteger (Array4 Word64) where+    liFromInteger = array4FromInteger+    liToInteger = array4ToInteger+    liBitSize _ = bitSize (undefined :: Word64) * 4+++-- | Class of CBRNG counters.+class LimitedInteger a => Counter a where+    -- | Skip ahead the given amount of steps.+    skip :: Integer -> a -> a+    skip i x = liFromInteger (liToInteger x + i)+    -- | Increment the counter.+    -- Usually this function is faster than @'skip' 1@.+    increment :: a -> a+    increment = skip 1+++instance (LimitedInteger (Array2 a), Ord a, Num a, Bounded a) => Counter (Array2 a) where+    increment (c0, c1)+        | c1 < maxBound = (c0, c1 + 1)+        | otherwise = (c0 + 1, 0)++instance (LimitedInteger (Array4 a), Ord a, Num a, Bounded a) => Counter (Array4 a) where+    increment (c0, c1, c2, c3)+        | c3 < maxBound = (c0, c1, c2, c3 + 1)+        | c2 < maxBound = (c0, c1, c2 + 1, 0)+        | c1 < maxBound = (c0, c1 + 1, 0, 0)+        | otherwise = (c0 + 1, 0, 0, 0)+++-- | Class of objects allowing the extraction of 32-bit words from the given position.+class Word32Array a where+    -- | Returns a 'Word32' from a position in range @[0, 'numWords32' - 1)@.+    getWord32 :: Int -> a -> Word32+    -- | Number of 32-bit words in this array.+    numWords32 :: a -> Int++instance Word32Array (Array2 Word32) where+    getWord32 0 (x0, x1) = x0+    getWord32 1 (x0, x1) = x1+    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+    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+    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+    numWords32 _ = 8+++-- | Class of objects allowing the extraction of 64-bit words from a given position.+class Word64Array a where+    -- | Returns a 'Word64' from a position in range @[0, 'numWords64' - 1)@.+    getWord64 :: Int -> a -> Word64+    -- | Number of 64-bit words in this array.+    numWords64 :: a -> Int+++instance Word64Array (Array2 Word32) where+    getWord64 0 (x0, x1) = hi `shiftL` 32 + lo where+        lo = fromIntegral x1 :: Word64+        hi = fromIntegral x0 :: Word64+    numWords64 _ = 1++instance Word64Array (Array4 Word32) where+    getWord64 0 (x0, x1, x2, x3) = hi `shiftL` 32 + lo where+        lo = fromIntegral x1 :: Word64+        hi = fromIntegral x0 :: Word64+    getWord64 1 (x0, x1, x2, x3) = hi `shiftL` 32 + lo where+        lo = fromIntegral x2 :: Word64+        hi = fromIntegral x3 :: Word64+    numWords64 _ = 2++instance Word64Array (Array2 Word64) where+    getWord64 0 (x0, x1) = x0+    getWord64 1 (x0, x1) = x1+    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+    numWords64 _ = 4
+ test/TestPhilox.hs view
@@ -0,0 +1,101 @@+module TestPhilox (test_philox) where++import Data.Word++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.HUnit++import System.Random.Random123.Types+import System.Random.Random123.Philox+++-- Reference results were obtained using Random123 v1.07+++-- Checking reference results for Philox-2x32-10++test_philox2x32 = results @?= reference where+    key = 123 :: Word32+    rounds = 10+    counters = [+        (0x6f55b92a, 0xab1c5ea9),+        (0x2e24118f, 0xf96cd57b),+        (0x35c2faac, 0x229e22ea),+        (0x71d82da5, 0xe7758e07),+        (0xefdadeee, 0x58849b8f)]+    reference = [+        (0xc8a74eda, 0x43748166),+        (0x0f2f49b3, 0x5440de8c),+        (0x9b0b15f0, 0x62ad33f0),+        (0x8e0d363a, 0xec949c27),+        (0xef1c72c0, 0xabcdf6f6)]+    results = map (philox2R rounds key) counters+++-- Checking reference results for Philox-4x32-10++test_philox2x64 = results @?= reference where+    key = (123, 456) :: Array2 Word32+    rounds = 10+    counters = [+        (0x5bf34ff4, 0x98f9badb, 0x4f816cab, 0xe62bd835),+        (0xdfe40202, 0xdf14b7de, 0x9f66a741, 0xcf4157f7),+        (0x839ac18e, 0xa043ba06, 0x94fd2987, 0x7d176d4c),+        (0xdbba4414, 0x4a0462e2, 0x74cf99d4, 0x68d78dad),+        (0x694f3a06, 0xc113b26e, 0x6b7be5fe, 0x47e59594)]+    reference = [+        (0x01c5a89a, 0xc8783325, 0x6fcbdf46, 0x0e5e2c08),+        (0xbdfdcee8, 0x2302ddcb, 0x0c6b097d, 0xfe5b1b6d),+        (0x41852fa7, 0xca2e06e0, 0x421b06e6, 0x825db2b2),+        (0x858a0b3f, 0x9c4ee5ae, 0x409bca71, 0x6174268f),+        (0x1fb47ee3, 0x465c46e9, 0xac8a8a63, 0x770b5eb8)]+    results = map (philox4R rounds key) counters+++-- Checking reference results for Philox-2x64-10++test_philox4x32 = results @?= reference where+    key = 123 :: Word64+    rounds = 10+    counters = [+        (0xf5bd87c1f90bf000, 0xfdcf5569188d8000),+        (0x1fcbd563f0fc8e00, 0x9eb6d45bd5096000),+        (0x5baaae0aecd1e000, 0x53d0329123492c00),+        (0x62ef71add3320800, 0x625c1fc53fd21000),+        (0x83d3483f4f369000, 0x395f94432bdf0200)]+    reference = [+        (0x70aa5fafe6b960f0, 0xf0296d49836ec74d),+        (0x5e6a58a58da65da7, 0xd58ae0056c4f6eb0),+        (0x79feffb4c50d7a7e, 0x586c57e69f636783),+        (0x9f0ef9aa1c02cbb3, 0x64d05e4f231859ea),+        (0x529c1fe09c72783b, 0x6a3b27e993d5fd7b)]+    results = map (philox2R rounds key) counters+++-- Checking reference results for Philox-4x64-10++test_philox4x64 = results @?= reference where+    key = (123, 456) :: Array2 Word64+    rounds = 10+    counters = [+        (0x1d1fc5123d698500, 0x6a0fd3ccbc9d3800, 0xe93a590b53026000, 0x3b339cb99a06fa00),+        (0x22f53249be020e00, 0xcfbd27dc0b0dc000, 0xbe8468a6b6ac3000, 0x0428398af2cfcac0),+        (0xd07b0391ea202000, 0xc6bb23b0fb74c800, 0x62720dec16217800, 0xdd5d41a2c6c29800),+        (0x4f9ffd1a930a3800, 0x41ee8eae5f157c00, 0x1e7ac9fcae5af500, 0x9e618d09ef001000),+        (0x9712f6164d422800, 0xc04f3f2e6d87a800, 0x7e2369ed83cdac00, 0xdb986d520bfcc000)]+    reference = [+        (0xcf1ee3ae885c3928, 0x90a39b52bb92f018, 0x1e2c1e36cdafc6d5, 0x2068f5a63acafdbb),+        (0x28b86429c0cc8d2f, 0xedb2c9aeaa6ef776, 0x7615c3e5815ea96c, 0xdcf5e8849a76aec0),+        (0x775904470661a226, 0xeceefd4563c20c51, 0x5d842c642c640a6b, 0xd17f2f87ad2fa74e),+        (0x00c263e4bc04441f, 0xaecb35c835e03874, 0x46bb918e4a85adb7, 0x6c5fd577457f6315),+        (0x61ca2527c8acdb96, 0x87c6dd6227eb5256, 0x6901e9c532adea59, 0x9bd765a53cca4d5f)]+    results = map (philox4R rounds key) counters+++test_philox = testGroup "Philox, comparison with the reference" [+    testCase "2x32" test_philox2x32,+    testCase "4x32" test_philox4x32,+    testCase "2x64" test_philox2x64,+    testCase "4x64" test_philox4x64+    ]
+ test/TestRandomGen.hs view
@@ -0,0 +1,58 @@+-- | 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+++-- Expected mean and standard deviation for a list of uniformly distributed random floats+num_floats = 10000+e_mean = 0.5+e_var = 1 / 12+e_std = sqrt e_var+e_mean_std = e_std / sqrt (fromIntegral num_floats)+e_std_std = sqrt ((e_var ** 2) / (fromIntegral num_floats - 1) * 2)++-- Functions to calculate mean and stddev of a list (not very effective)+mean xs = sum xs / fromIntegral (length xs)+std xs = sqrt (sum xsquares / fromIntegral (length xs)) where+    xmean = mean xs+    xsquares = map (\x -> (x - xmean) ** 2) xs++-- Check that mean and stddev of a generated list are inside [-5,5] sigma interval+-- around their expected values (chance of failure ~1e-6).++test_gen32_mean = (xmean < e_mean + 5 * e_std && xmean > e_mean - 5 * e_std) @?= True where+    gen = mkCBRNG32 123456+    floats = take num_floats (randoms gen :: [Float])+    xmean = mean floats++test_gen32_std = (xstd < e_std + 5 * e_std_std && xstd > e_std - 5 * e_std_std) @?= True where+    gen = mkCBRNG32 123456+    floats = take num_floats (randoms gen :: [Float])+    xstd = std floats++test_gen64_mean = (xmean < e_mean + 5 * e_std && xmean > e_mean - 5 * e_std) @?= True where+    gen = mkCBRNG64 123456+    floats = take num_floats (randoms gen :: [Float])+    xmean = mean floats++test_gen64_std = (xstd < e_std + 5 * e_std_std && xstd > e_std - 5 * e_std_std) @?= True where+    gen = mkCBRNG64 123456+    floats = take num_floats (randoms gen :: [Float])+    xstd = std floats+++test_randomgen = testGroup "RandomGen" [+    testCase "Default 32-bit (mean of array of floats)" test_gen32_mean,+    testCase "Default 32-bit (std of array of floats)" test_gen32_std,+    testCase "Default 64-bit (mean of array of floats)" test_gen64_mean,+    testCase "Default 64-bit (std of array of floats)" test_gen64_std+    ]
+ test/TestThreefry.hs view
@@ -0,0 +1,102 @@+module TestThreefry (test_threefry) where++import Data.Word++import Test.Framework (testGroup)+import Test.Framework.Providers.HUnit+import Test.HUnit++import System.Random.Random123.Types+import System.Random.Random123.Threefry+++-- Reference results were obtained using Random123 v1.07+-- (with a minor bug fixed --- rotation constant order is broken in 20-th round)+++-- Checking reference results for Threefry-2x32-32++test_threefry2x32 = results @?= reference where+    key = (123, 456) :: Array2 Word32+    rounds = 32+    counters = [+        (0x058741f8, 0x346b43e7),+        (0xcedc5891, 0x2c5c1d28),+        (0x5a086b94, 0x1acbdc33),+        (0xa76cc7bf, 0x857c8f0f),+        (0xad8d9e57, 0x01b1d9fa)]+    reference = [+        (0x2d4c5ff6, 0x76375d6e),+        (0x78b73f35, 0xea905a45),+        (0xfde30fed, 0x9c104974),+        (0x15861c3d, 0x293ba61f),+        (0x5033c8d1, 0x7b92151a)]+    results = map (threefry2R rounds key) counters+++-- Checking reference results for Threefry-4x32-72++test_threefry2x64 = results @?= reference where+    key = (123, 456, 789, 101112) :: Array4 Word32+    rounds = 72+    counters = [+        (0x589c8db6, 0x19d662ad, 0x3e63b1e5, 0x25dad2c5),+        (0x403512be, 0x370c9a86, 0x66d4c418, 0x92ed3769),+        (0x1920eb77, 0x2d6340fe, 0xa2f618e3, 0xb8e4aacf),+        (0x66005aa2, 0xf70ecfdf, 0xe38e29c5, 0xcbbd54d2),+        (0x295e45f0, 0xa3d266cd, 0xb102152d, 0x2f57b507)]+    reference = [+        (0xcc07f462, 0x18cbe434, 0x97b800fe, 0xc515a3c1),+        (0x67bf63ec, 0x08274d21, 0x18557796, 0x36706c15),+        (0x428a06be, 0xbf1caad7, 0x25e51e44, 0x89e4bd74),+        (0xbfff9163, 0x4106e304, 0x03157e56, 0xebfbd11c),+        (0x5a1f4a9c, 0x1725d096, 0x2b561b17, 0xeb9b4807)]+    results = map (threefry4R rounds key) counters+++-- Checking reference results for Threefry-2x64-32++test_threefry4x32 = results @?= reference where+    key = (123, 456) :: Array2 Word64+    rounds = 32+    counters = [+        (0x097a4f5083c77380, 0x51794d6039c75400),+        (0x65918ba6ccfe6400, 0x3d91c69276916c00),+        (0xdfe3269c92f1f800, 0xe6a0ab67f2207800),+        (0x6240b418d521f000, 0x40299ed82854f400),+        (0x9acc98590f691000, 0x89df228bd6bae800)]+    reference = [+        (0xa6102e76d20f3382, 0x44dbf36431f9e9ee),+        (0x0da48a45f9295d0e, 0x95d3b41c67e0f4c2),+        (0x050a8dfccae89041, 0x76c474fad535292d),+        (0xea84579be191a8fc, 0x3236c9527cba73e9),+        (0x31f9c11860715320, 0x7ba946b5076efd08)]+    results = map (threefry2R rounds key) counters+++-- Checking reference results for Threefry-4x64-72++test_threefry4x64 = results @?= reference where+    key = (123, 456, 789, 101112) :: Array4 Word64+    rounds = 72+    counters = [+        (0x916c0b160f927800, 0x52eb051cf7d14400, 0xbb685306834af800, 0x472bc9ebd7c67000),+        (0x61b7386b8fea1800, 0x8e3c63aaaf6f0000, 0x32a99c88983d4400, 0x0e6631cb0b255a00),+        (0x5ac82c4303a38400, 0xe3b2d6d630f00000, 0xb0fd6567c0918800, 0x103c4caced3ad200),+        (0x8df94ae6b44d9000, 0x6a20b71e020c1800, 0x7a7554df0c355000, 0x0ab535e581250880),+        (0x2f8ec42369683200, 0xda1197831643b000, 0xe1e589e32f32c800, 0x0b7a9b0053df1480)]+    reference = [+        (0x8d72c51e3e02c62c, 0xf343d5bdd4428602, 0xc3769f920f6bb846, 0x68f81b2a1276a4e1),+        (0x333f98bad6286630, 0xbd1330b5f841bc3a, 0x95f3aab12571ae68, 0xbc2f487dd4b9d63c),+        (0xebec496e8c1198ab, 0xdd7ea52e93dbf166, 0x6894711ca28c7c12, 0x5817ba9c9f36f1bc),+        (0x892f196d93952843, 0x4341d023d4fe64f3, 0x72bd9fba2c6ed9c3, 0x5f7affd1dd0b449f),+        (0xc91f23d22b34be06, 0x8ddbf89963b13e67, 0x230bb28bfb3f4b3c, 0xefaa712baaa3dafb)]+    results = map (threefry4R rounds key) counters+++test_threefry = testGroup "Threefry, comparison with the reference" [+    testCase "2x32" test_threefry2x32,+    testCase "4x32" test_threefry4x32,+    testCase "2x64" test_threefry2x64,+    testCase "4x64" test_threefry4x64+    ]
+ test/TestTypeclasses.hs view
@@ -0,0 +1,116 @@+-- | Test standard RandomGen interface of Random123-backed generators.+module TestTypeclasses (test_typeclasses) where++import Data.Word++import Test.Framework (testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import System.Random.Random123.Types+++test_li1x32_bijection initial = initial == mapped initial where+    types = initial :: Word32+    mapped = liFromInteger . liToInteger++test_li2x32_bijection initial = initial == mapped initial where+    types = initial :: Array2 Word32+    mapped = liFromInteger . liToInteger++test_li4x32_bijection initial = initial == mapped initial where+    types = initial :: Array4 Word32+    mapped = liFromInteger . liToInteger++test_li1x64_bijection initial = initial == mapped initial where+    types = initial :: Word64+    mapped = liFromInteger . liToInteger++test_li2x64_bijection initial = initial == mapped initial where+    types = initial :: Array2 Word64+    mapped = liFromInteger . liToInteger++test_li4x64_bijection initial = initial == mapped initial where+    types = initial :: Array4 Word64+    mapped = liFromInteger . liToInteger+++test_li1x32_bitsize li = liToInteger li < 2 ^ liBitSize li where+    types = li :: Word32++test_li2x32_bitsize li = liToInteger li < 2 ^ liBitSize li where+    types = li :: Array2 Word32++test_li4x32_bitsize li = liToInteger li < 2 ^ liBitSize li where+    types = li :: Array4 Word32++test_li1x64_bitsize li = liToInteger li < 2 ^ liBitSize li where+    types = li :: Word64++test_li2x64_bitsize li = liToInteger li < 2 ^ liBitSize li where+    types = li :: Array2 Word64++test_li4x64_bitsize li = liToInteger li < 2 ^ liBitSize li where+    types = li :: Array4 Word64+++test_ctr2x32_skip ctr i = liFromInteger (liToInteger ctr + i) == skip i ctr where+    types = (ctr :: Array2 Word32, i :: Integer)++test_ctr4x32_skip ctr i = liFromInteger (liToInteger ctr + i) == skip i ctr where+    types = (ctr :: Array4 Word32, i :: Integer)++test_ctr2x64_skip ctr i = liFromInteger (liToInteger ctr + i) == skip i ctr where+    types = (ctr :: Array2 Word64, i :: Integer)++test_ctr4x64_skip ctr i = liFromInteger (liToInteger ctr + i) == skip i ctr where+    types = (ctr :: Array4 Word64, i :: Integer)+++test_ctr2x32_increment ctr = increment ctr == skip 1 ctr where+    types = ctr :: Array2 Word32++test_ctr4x32_increment ctr = increment ctr == skip 1 ctr where+    types = ctr :: Array4 Word32++test_ctr2x64_increment ctr = increment ctr == skip 1 ctr where+    types = ctr :: Array2 Word64++test_ctr4x64_increment ctr = increment ctr == skip 1 ctr where+    types = ctr :: Array4 Word64++++test_typeclasses = testGroup "Typeclasses" [+    testGroup "LimitedInteger" [+        testGroup "liFromInteger . liToInteger == id" [+            testProperty "1x32" test_li1x32_bijection,+            testProperty "2x32" test_li2x32_bijection,+            testProperty "4x32" test_li4x32_bijection,+            testProperty "1x64" test_li1x64_bijection,+            testProperty "2x64" test_li2x64_bijection,+            testProperty "4x64" test_li4x64_bijection+            ],+        testGroup "liToInteger < 2 ^ liBitSize" [+            testProperty "1x32" test_li1x32_bitsize,+            testProperty "2x32" test_li2x32_bitsize,+            testProperty "4x32" test_li4x32_bitsize,+            testProperty "1x64" test_li1x64_bitsize,+            testProperty "2x64" test_li2x64_bitsize,+            testProperty "4x64" test_li4x64_bitsize+            ]+        ],+    testGroup "Counter" [+        testGroup "skip behaves like the default implementation" [+            testProperty "2x32" test_ctr2x32_skip,+            testProperty "4x32" test_ctr4x32_skip,+            testProperty "2x64" test_ctr2x64_skip,+            testProperty "4x64" test_ctr4x64_skip+            ],+        testGroup "increment == skip 1" [+            testProperty "2x32" test_ctr2x32_increment,+            testProperty "4x32" test_ctr4x32_increment,+            testProperty "2x64" test_ctr2x64_increment,+            testProperty "4x64" test_ctr4x64_increment+            ]+        ]+    ]
+ test/hlint.sh view
@@ -0,0 +1,3 @@+#!/bin/bash+hlint ../System/Random -i "Use camelCase"+hlint ./ -i "Use camelCase"
+ test/profile.sh view
@@ -0,0 +1,9 @@+#!/bin/bash+rm profile+rm profile.hi+rm profile.o++ghc -i../ -prof -fprof-auto -rtsopts -O2 profile.hs+./profile +RTS -p++cat profile.prof
+ test/test.hs view
@@ -0,0 +1,15 @@+import Test.Framework (defaultMain)++import TestThreefry (test_threefry)+import TestPhilox (test_philox)+import TestTypeclasses (test_typeclasses)+import TestRandomGen (test_randomgen)++tests = [+    test_threefry,+    test_philox,+    test_typeclasses,+    test_randomgen+    ]++main = defaultMain tests
+ test/test.sh view
@@ -0,0 +1,2 @@+#!/bin/bash+runhaskell -i../ test.hs $@
+ test/test_perf.hs view
@@ -0,0 +1,90 @@+import Data.Word++import Criterion.Main+import Criterion.Config++import System.Random.Random123.Threefry+import System.Random.Random123.Misc+import System.Random.Random123.Types+import System.Random.Random123+import System.Random++rng_iterations = 10000+bijection_iterations = 10000++testfunc rng = sum (take rng_iterations (randoms rng :: [Float]))++test_rng_default 32 key = testfunc (mkCBRNG32 key)+test_rng_default 64 key = testfunc (mkCBRNG64 key)++data Bijection =+    Philox4x32 | Philox4x64 | Threefry4x32 | Threefry4x64 |+    Philox2x32 | Philox2x64 | Threefry2x32 | Threefry2x64++key1x32 key = liFromInteger key :: Word32+key2x32 key = liFromInteger key :: Array2 Word32+key2x64 key = liFromInteger key :: Array2 Word64+key1x64 key = liFromInteger key :: Word64+key4x32 key = liFromInteger key :: Array4 Word32+key4x64 key = liFromInteger key :: Array4 Word64++test_rng_custom 32 Philox4x32 key = testfunc (mkCustomCBRNG32 philox4 $ key2x32 key)+test_rng_custom 32 Philox4x64 key = testfunc (mkCustomCBRNG32 philox4 $ key2x64 key)+test_rng_custom 64 Philox4x32 key = testfunc (mkCustomCBRNG64 philox4 $ key2x32 key)+test_rng_custom 64 Philox4x64 key = testfunc (mkCustomCBRNG64 philox4 $ key2x64 key)+test_rng_custom 32 Threefry4x32 key = testfunc (mkCustomCBRNG32 threefry4 $ key4x32 key)+test_rng_custom 32 Threefry4x64 key = testfunc (mkCustomCBRNG32 threefry4 $ key4x64 key)+test_rng_custom 64 Threefry4x32 key = testfunc (mkCustomCBRNG64 threefry4 $ key4x32 key)+test_rng_custom 64 Threefry4x64 key = testfunc (mkCustomCBRNG64 threefry4 $ key4x64 key)+++-- Normalizing iteration number to make sure every bijection+-- processes the same amount of data.+test_bijection2x32 Philox2x32 key =+    apply_ (philox2 $ key1x32 key) bijection_iterations (liFromInteger 0)+test_bijection2x32 Threefry2x32 key =+    apply_ (threefry2 $ key2x32 key) bijection_iterations (liFromInteger 0)+test_bijection4x32 Philox4x32 key =+    apply_ (philox4 $ key2x32 key) (bijection_iterations `div` 2) (liFromInteger 0)+test_bijection4x32 Threefry4x32 key =+    apply_ (threefry4 $ key4x32 key) (bijection_iterations `div` 2) (liFromInteger 0)+test_bijection2x64 Philox2x64 key =+    apply_ (philox2 $ key1x64 key) (bijection_iterations `div` 2) (liFromInteger 0)+test_bijection2x64 Threefry2x64 key =+    apply_ (threefry2 $ key2x64 key) (bijection_iterations `div` 2) (liFromInteger 0)+test_bijection4x64 Philox4x64 key =+    apply_ (philox4 $ key2x64 key) (bijection_iterations `div` 4) (liFromInteger 0)+test_bijection4x64 Threefry4x64 key =+    apply_ (threefry4 $ key4x64 key) (bijection_iterations `div` 4) (liFromInteger 0)+++myConfig = defaultConfig {+    cfgPerformGC = ljust True,+    cfgReport = ljust "test_perf.html" }++main = defaultMainWith myConfig (return ()) [+    bgroup "Bijections" [+        bench "Philox-2x32" $ nf (test_bijection2x32 Philox2x32) 101,+        bench "Philox-4x32" $ nf (test_bijection4x32 Philox4x32) 102,+        bench "Philox-2x64" $ nf (test_bijection2x64 Philox2x64) 103,+        bench "Philox-4x64" $ nf (test_bijection4x64 Philox4x64) 104,+        bench "Threefry-2x32" $ nf (test_bijection2x32 Threefry2x32) 105,+        bench "Threefry-4x32" $ nf (test_bijection4x32 Threefry4x32) 106,+        bench "Threefry-2x64" $ nf (test_bijection2x64 Threefry2x64) 107,+        bench "Threefry-4x64" $ nf (test_bijection4x64 Threefry4x64) 108+        ],+    bgroup "32-bit RNGs" [+        bench "Default 32-bit" $ nf (test_rng_default 32) 1,+        bench "Philox-4x32" $ nf (test_rng_custom 32 Philox4x32) 2,+        bench "Philox-4x64" $ nf (test_rng_custom 32 Philox4x64) 3,+        bench "Threefry-4x32" $ nf (test_rng_custom 32 Threefry4x32) 4,+        bench "Threefry-4x64" $ nf (test_rng_custom 32 Threefry4x64) 5+        ],+    bgroup "64-bit RNGs" [+        bench "Default 64-bit" $ nf (test_rng_default 64) 6,+        bench "Philox-4x32" $ nf (test_rng_custom 64 Philox4x32) 7,+        bench "Philox-4x64" $ nf (test_rng_custom 64 Philox4x64) 8,+        bench "Threefry-4x32" $ nf (test_rng_custom 64 Threefry4x32) 9,+        bench "Threefry-4x64" $ nf (test_rng_custom 64 Threefry4x64) 10+        ]+    ]
+ test/test_perf.sh view
@@ -0,0 +1,8 @@+#!/bin/bash+rm test_perf+rm test_perf.hi+rm test_perf.o++ghc -i../ -O2 test_perf.hs++./test_perf