xorshift-plus (empty) → 0.1.0.0

raw patch · 10 files changed

+415/−0 lines, 10 filesdep +QuickCheckdep +Xorshift128Plusdep +basesetup-changed

Dependencies added: QuickCheck, Xorshift128Plus, base, doctest, gauge, ghc-prim, hspec, random, xorshift, xorshift-plus

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +23/−0
• Setup.hs +2/−0
• benchmarks/micro/micro.hs +62/−0
• src/Random/XorshiftPlus.hs +125/−0
• tests/doctest/Main.hs +6/−0
• tests/spec/Random/XorshiftPlusSpec.hs +91/−0
• tests/spec/Spec.hs +1/−0
• xorshift-plus.cabal +70/−0

@@ -0,0 +1,5 @@+# Revision history for xorshift-plus++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2019, OSANAI Kazuyoshi++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 OSANAI Kazuyoshi 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.

@@ -0,0 +1,23 @@+# xorshift-plus++Simple implementation of xorshift+.++```haskell+import Random.XorshiftPlus+main = do+  s <- genXorshiftPlusInt 1+  i <- getInt s+  print i -- 2455688531189531812+```++## Performance++```+> cabal new-run --enable-benchmarks micro -- compareWithOtherPRNGs --small+Up to date+compareWithOtherPRNGs/xorshift-plus_Int (THIS PACKAGE) mean 10.63 μs  ( +- 40.63 ns  )+compareWithOtherPRNGs/xorshift-plus_Word (THIS PACKAGE) mean 10.72 μs  ( +- 36.54 ns  )+compareWithOtherPRNGs/xorshift_Int32     mean 250.5 μs  ( +- 917.1 ns  )+compareWithOtherPRNGs/xorshift_Ina64     mean 457.1 μs  ( +- 1.070 μs  )+compareWithOtherPRNGs/Xorshift128Plus_Word64 mean 24.61 μs  ( +- 111.9 ns  )+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,62 @@+{-# LANGUAGE TypeApplications #-}++module Main where++import Gauge.Main+import Data.Int+import Data.Word+import System.Random+import Random.XorshiftPlus+import Random.Xorshift.Int32+import Random.Xorshift.Int64+import qualified System.Random.Xorshift128Plus as X128+import System.CPUTime++size :: Int+size = 1000++getSeed :: Num a => IO a+getSeed = fromInteger `fmap` getCPUTime++getRandomIntList :: Int -> IO [Int]+getRandomIntList n = do+  seed <- getSeed @ Int+  xorshift <- genXorshiftPlusInt seed+  sequence $ replicate n $ getInt xorshift++getRandomWordList :: Int -> IO [Word]+getRandomWordList n = do+  seed <- getSeed @ Word+  xorshift <- genXorshiftPlusWord seed+  sequence $ replicate n $ getWord xorshift++getRandomIntList_xorshift_Int32 :: Int -> IO [Int32]+getRandomIntList_xorshift_Int32 n = do+  seed <- getSeed @ Int32+  let xorshift = makeXorshift32 seed+  return $ take n $ randoms xorshift++getRandomIntList_xorshift_Int64 :: Int -> IO [Int64]+getRandomIntList_xorshift_Int64 n = do+  seed <- getSeed @ Int64+  let xorshift = makeXorshift64 seed+  return $ take n $ randoms xorshift++getRandomWord64List_Xorshift128Plus :: Int -> IO [Word64]+getRandomWord64List_Xorshift128Plus n = do+  seed <- getSeed @ Word64+  let xorshift = X128.initialize seed+  return $ take n $ makeList xorshift+  where+    makeList gen = let (x, gen') = X128.next gen in x : (makeList gen')++main :: IO ()+main = defaultMain+  [ bgroup "compareWithOtherPRNGs"+    [ bench "xorshift-plus_Int (THIS PACKAGE)" $ nfIO (getRandomIntList size)+    , bench "xorshift-plus_Word (THIS PACKAGE)" $ nfIO (getRandomWordList size)+    , bench "xorshift_Int32" $ nfIO (getRandomIntList_xorshift_Int32 size)+    , bench "xorshift_Ina64" $ nfIO (getRandomIntList_xorshift_Int64 size)+    , bench "Xorshift128Plus_Word64" $ nfIO (getRandomWord64List_Xorshift128Plus size)+    ]+  ]

@@ -0,0 +1,125 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StrictData #-}++{-|+Module      : Random.XorshiftPlus+Description : xorshift+ implementation+Copyright   : (c) OSANAI Kazuyoshi, 2019+License     : BSD 3-Clause+Maintainer  : osmium.k@gmail.com+Stability   : experimental+Portability : GHC, word size 64bit++Simple implementation of xorshift+.++>>> gen <- genXorshiftPlusInt 1+>>> getInt gen+2455688531189531812+-}+module Random.XorshiftPlus+  (+  -- * IO version+    XorshiftPlus+  -- ** Generator+  , genXorshiftPlusWord+  , genXorshiftPlusInt+  -- ** Values+  , getWord+  , getInt+  , getDouble+  -- * Low level, ST version+  , XorshiftPlusST+  , genXorshiftPlusWordST+  , getWordST+  -- * Internal+  , splitMix64Next+  ) where++-- import Data.IORef+import Data.STRef+-- import Data.Coerce+import Control.Monad.ST+import GHC.Types+import GHC.Prim+import Prelude hiding (not)++-- $setup+-- >>> :set -XMagicHash++data XorshiftPlus1 = XorshiftPlus1 Word# Word#++-- | Random state+newtype XorshiftPlusST s = XorshiftPlusST (STRef s XorshiftPlus1)++-- | Random state+type XorshiftPlus = XorshiftPlusST RealWorld++plus :: Word# -> Word# -> Word#+plus = plusWord#++times :: Word# -> Word# -> Word#+times = timesWord#++xor :: Word# -> Word# -> Word#+xor = xor#++shiftL :: Word# -> Int# -> Word#+shiftL = uncheckedShiftL#++shiftR :: Word# -> Int# -> Word#+shiftR = uncheckedShiftRL#++-- | For first return value.+--+-- >>> W# (splitMix64Next 1##)+-- 10451216379200822465+splitMix64Next :: Word# -> Word#+splitMix64Next x =+  let z1 = x `plus` 0x9e3779b97f4a7c15## in+  let z2 = (z1 `xor` (z1 `shiftR` 30#)) `times` 0xbf58476d1ce4e5b9## in+  let z3 = (z2 `xor` (z2 `shiftR` 27#)) `times` 0x94d049bb133111eb## in+  z3 `xor` (z3 `shiftR` 31#)++-- | Generate a new random state by a Word seed.+genXorshiftPlusWordST :: Word -> ST s (XorshiftPlusST s)+genXorshiftPlusWordST (W# w) = do+  ref <- newSTRef (XorshiftPlus1 w (splitMix64Next w))+  return $ XorshiftPlusST ref++-- | Generate a new random state by a Word seed.+genXorshiftPlusWord+  :: Word            -- ^ random seed+  -> IO XorshiftPlus+genXorshiftPlusWord w = stToIO (genXorshiftPlusWordST w)++-- | Generate a new random state by an Int seed.+genXorshiftPlusInt+  :: Int             -- ^ random seed+  -> IO XorshiftPlus+genXorshiftPlusInt i = genXorshiftPlusWord (fromIntegral i)++-- | Get a new random value as Word.+getWordST :: XorshiftPlusST s -> ST s Word+getWordST (XorshiftPlusST ref) = do+  XorshiftPlus1 w0 w1 <- readSTRef ref+  let x = w0 `xor` (w0 `shiftL` 17#)+  let y = x `xor` w1 `xor` (x `shiftR` 17#) `xor` (w1 `shiftR` 26#)+  writeSTRef ref $ XorshiftPlus1 w1 y+  return $ W# (w1 `plus` y)++-- | Get a new random value as Word.+getWord :: XorshiftPlus -> IO Word+getWord = stToIO . getWordST++-- | Get a new random value as Int.+getInt :: XorshiftPlus -> IO Int+getInt x = do+  w <- getWord x+  return $ fromIntegral w++-- | Get a new random value as Double [0, 1.0].+getDouble :: XorshiftPlus -> IO Double+getDouble x = do+  let maxWord = fromIntegral (maxBound :: Word)+  w <- getWord x+  return $ (fromIntegral w) / maxWord

@@ -0,0 +1,6 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "src/"]

@@ -0,0 +1,91 @@+{-# LANGUAGE TypeApplications #-}++module Random.XorshiftPlusSpec where++import Test.Hspec+import Test.QuickCheck+import qualified Test.QuickCheck.Monadic as QC+import Random.XorshiftPlus+import Data.List+import Control.Monad+import System.CPUTime++run :: IO ()+run = do+  seed <- getCPUTime+  xorshift <- genXorshiftPlusInt (fromInteger seed)+  ws <- sequence $ replicate 10 $ getWord xorshift+  print ws+  is <- sequence $ replicate 10 $ getInt xorshift+  print is+  ds <- sequence $ replicate 10 $ getDouble xorshift+  print ds++rangeDouble :: Property+rangeDouble = property $ \seed -> QC.monadicIO $ do+  xorshift <- QC.run $ genXorshiftPlusInt seed+  ret <- QC.run $ sequence $ replicate 100 $ getDouble xorshift+  QC.assert $ all (\r -> 0.0 <= r && r <= 1.0) ret++calcChisq :: [Int] -> Double -> Double+calcChisq count expected = foldl' f 0.0 $ count+  where+    f :: Double -> Int -> Double+    f r x = r + ((((fromIntegral x) - expected)) ** 2 / expected)++testChisq :: Int -> Int -> [Int] -> Double+testChisq n k randoms = calcChisq count (fromIntegral n / fromIntegral k)+  where+    minInt = toInteger (minBound :: Int)+    maxInt = toInteger (maxBound :: Int)+    step = (maxInt - minInt) `div` (toInteger k)+    randoms' = map (\r -> fromInteger @Int ((toInteger r - minInt) `div` step)) randoms+    count = map length . group $ sort randoms'++execTestChisq :: IO Bool+execTestChisq = do+  xorshift <- genXorshiftPlusInt 1+  let (k, limit) = (10, 16.919)+  let n = k * 100+  randoms <- sequence $ replicate n $ getInt xorshift+  let ret = testChisq n k randoms+  return $ ret < limit++testCor :: Int -> Int -> [Double] -> Double+testCor n k randoms = let s = testCor' n randoms 0.0 in+                      let n' = fromIntegral n in+                      sqrt n' * (12.0 * s / n' - 3.0) / sqrt 13.0+  where+    testCor' :: Int -> [Double] -> Double -> Double+    testCor' 0 _       res = res+    testCor' n' randoms' res =+      let (buff, restRandoms) = splitAt k randoms' in+      let x =  head buff * head restRandoms in+      testCor' (n'-1) (tail randoms') (res+x)++execTestCor :: IO Bool+execTestCor = do+  xorshift <- genXorshiftPlusInt 1+  let n = 2500+  randoms <- sequence $ replicate ((n+1) * 3) $ getDouble xorshift+  cors <- forM [1, 2, 3] $ \k -> do+    let x = testCor n k randoms+    return x+  return $ all (\x -> (-1.96 < x && x < 1.96)) cors++spec :: Spec+spec = do+  describe "_run" $ do+    it "_run" $ do+      run+  describe "range" $ do+    it "getDouble" $ do+      rangeDouble+  describe "chisq" $ do+    it "chisq" $ do+      ret <- execTestChisq+      ret `shouldBe` True+  describe "cor" $ do+    it "cor" $ do+      ret <- execTestCor+      ret `shouldBe` True

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,70 @@+cabal-version:       2.4+name:                xorshift-plus+version:             0.1.0.0++synopsis:            Simple implementation of xorshift+ PRNG+-- description:++homepage:            https://github.com/syocy/xorshift-plus+bug-reports:         https://github.com/syocy/xorshift-plus/issues++license:             BSD-3-Clause+license-file:        LICENSE++author:              OSANAI Kazuyoshi+maintainer:          osmium.k@gmail.com+-- copyright:++category:            Math++extra-source-files:  README.md+                   , CHANGELOG.md++source-repository head+  type:              git+  location:          https://github.com/syocy/xorshift-plus+              +library+  exposed-modules:     Random.XorshiftPlus+  -- other-extensions:+  build-depends:       base ^>=4.12.0.0+                     , ghc-prim+  hs-source-dirs:      src+  ghc-options:         -Wall -Wcompat -O2+  default-language:    Haskell2010++test-suite doctests+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  hs-source-dirs:      tests/doctest+  build-depends:       base+                     , doctest >= 0.8+  ghc-options:         -Wall -Wcompat+  default-language:    Haskell2010++test-suite specs+  type:                exitcode-stdio-1.0+  main-is:             Spec.hs+  hs-source-dirs:      tests/spec+  other-modules:       Random.XorshiftPlusSpec+  build-depends:       base+                     , xorshift-plus+                     , hspec >= 2+                     , QuickCheck+  build-tool-depends:  hspec-discover:hspec-discover >= 2+  ghc-options:         -Wall -Wcompat+  default-language:    Haskell2010++benchmark micro+  type:                exitcode-stdio-1.0+  main-is:             micro.hs+  hs-source-dirs:      benchmarks/micro+  build-depends:       base+                     , xorshift-plus+                     , gauge >= 0.2+                     , xorshift >= 2+                     , random >= 1.1+                     , Xorshift128Plus == 0.1.0.2+  ghc-options:         -Wall -Wcompat -O2+  default-language:    Haskell2010+