summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AC-Random.cabal53
-rw-r--r--License.txt30
-rw-r--r--Random/MWC/Monadic.hs82
-rw-r--r--Random/MWC/Primitive.hs64
-rw-r--r--Random/MWC/Pure.hs287
-rw-r--r--Setup.hs2
6 files changed, 518 insertions, 0 deletions
diff --git a/AC-Random.cabal b/AC-Random.cabal
new file mode 100644
index 0000000..0b77739
--- /dev/null
+++ b/AC-Random.cabal
@@ -0,0 +1,53 @@
+Cabal-version: >=1.6
+Name: AC-Random
+Version: 0.1
+Synopsis: A pure Haskell PRNG.
+Description:
+
+ This is a psuedo-random number generator (PRNG). It is designed to
+ replace the standard Haskell '98 PRNG from the @random@ package. It
+ has the following properties:
+ .
+ * Nicer API than @random@. (Supports all sizes of @Int@ and
+ @Word@, for example.)
+ .
+ * Much faster than @random@. (In my tests, roughly 14x faster.)
+ .
+ * Comparable quality to @random@. (Both libraries pass the \"Die
+ Harder\" suite of statistical randomness tests. In other words,
+ neither has any overly obvious pattern to the \"random\" numbers
+ it produces. Both libraries pass Die Harder with similar scores.)
+ .
+ * 100% Haskell '98 code. No compiler-specific features. No
+ external dependencies. Builds everywhere.
+ .
+ * Pure functions and simple ADTs. No mutable state, no @IO@ monad.
+ Simple API.
+ .
+ The actual algorithm is a lag-4 Multiply With Carry (MWC)
+ generator, using 32-bit arithmetic. (Should be fast on 32-bit and
+ 64-bit platforms.) If my algebra is correct, its period should be
+ roughly 1.46 * 10^48. (By constrast, @random@ claims to have a
+ period of only 2.30 * 10^18.)
+ .
+ Note that this algorithm, by itself, is /not/ cryptographically
+ secure.
+ .
+ Changes:
+ .
+ * Initial release.
+
+License: BSD3
+License-file: License.txt
+Author: Andrew Coppin
+Maintainer: MathematicalOrchid@hotmail.com
+Category: Random
+Build-type: Simple
+
+Library
+ Exposed-modules:
+ Random.MWC.Primitive
+ Random.MWC.Pure
+ Random.MWC.Monadic
+ Build-depends:
+ base == 4.*
diff --git a/License.txt b/License.txt
new file mode 100644
index 0000000..c217103
--- /dev/null
+++ b/License.txt
@@ -0,0 +1,30 @@
+Copyright (c)2011, Andrew Coppin
+
+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 Andrew Coppin 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.
diff --git a/Random/MWC/Monadic.hs b/Random/MWC/Monadic.hs
new file mode 100644
index 0000000..52e5ddc
--- /dev/null
+++ b/Random/MWC/Monadic.hs
@@ -0,0 +1,82 @@
+{- |
+ Monadic functions for random number generation.
+
+ Because manually threading the correct 'Seed' value around is
+ tedious and error-prone, one common approach is to use some
+ kind of state monad to hide it. This module provides the
+ convenience functions to make this easy; just write a
+ 'RandomM' instance for your particular monad, and then you
+ can easily and conveniently generate random numbers.
+-}
+
+module Random.MWC.Monadic
+ (
+ -- * Random seed
+ Seed (),
+
+ -- * Random monads
+ RandomM (..),
+
+ -- * Monadic operations
+ bounded_randomM, unit_randomM, range_randomM,
+ )
+ where
+
+import Random.MWC.Pure
+
+{- |
+ The class of monads holding a single random 'Seed' within their
+ state.
+-}
+class Monad m => RandomM m where
+ -- | Fetch the current 'Seed' value.
+ get_random_seed :: m Seed
+
+ -- | Replace the current 'Seed' value.
+ set_random_seed :: Seed -> m ()
+
+{- |
+ The monadic analogue of 'bounded_random'.
+
+ Return a value randomly chosen between 'minBound' and 'maxBound'.
+ Uses the current 'Seed' value from within the monad, automatically
+ updating said seed value in the process. Thus, repeatedly calling
+ this function will yield different successive values.
+-}
+bounded_randomM :: (RandomM m, BoundedRandom x) => m x
+bounded_randomM = do
+ s0 <- get_random_seed
+ let (x, s1) = bounded_random s0
+ set_random_seed s1
+ return x
+
+{- |
+ The monadic analogue of 'unit_random'.
+
+ Returns a value randomly chosen between \"zero\" and \"one\". Uses
+ the current 'Seed' value from within the monad, automatically
+ updating said seed value in the process. Thus, repeatedly calling
+ this function will yield different successive values.
+-}
+unit_randomM :: (RandomM m, UnitRandom x) => m x
+unit_randomM = do
+ s0 <- get_random_seed
+ let (x, s1) = unit_random s0
+ set_random_seed s1
+ return x
+
+{- |
+ The monadic analogue of 'range_random'.
+
+ Returns a value randomly chosen from a user-specified range
+ (inclusive). Uses the current 'Seed' value from within the monad,
+ automatically updating said seed value in the process. Thus,
+ repeatedly calling this function will yield different successive
+ values.
+-}
+range_randomM :: (RandomM m, RangeRandom x) => (x, x) -> m x
+range_randomM xr = do
+ s0 <- get_random_seed
+ let (x, s1) = range_random xr s0
+ set_random_seed s1
+ return x
diff --git a/Random/MWC/Primitive.hs b/Random/MWC/Primitive.hs
new file mode 100644
index 0000000..0fa1422
--- /dev/null
+++ b/Random/MWC/Primitive.hs
@@ -0,0 +1,64 @@
+{- |
+ This module contains the raw random number generator algorithm.
+ Usually you would import "Random.MWC.Pure" for a more convinient
+ API.
+-}
+
+module Random.MWC.Primitive
+ (
+ -- * Random seed
+ Seed (), seed,
+
+ -- * Random number generation
+ next_word,
+ )
+ where
+
+import Data.Bits
+import Data.Word
+
+-- | An immutable random seed value for the PRNG.
+data Seed =
+ Seed
+ {
+ word1, word2, word3, word4, carry :: {-# UNPACK #-} !Word32
+ }
+ deriving (Eq, Ord)
+
+magic = 0xFFFFFF4E :: Word64
+
+seed0 =
+ Seed
+ 0x8DC106A9
+ 0x42FE9BA1
+ 0x0284BC8A
+ 0xABA48CE2
+ 0x5935B28D
+
+{- |
+ Create a new random seed value from the supplied list of 'Word32'
+ values. If the list is empty, return a default, hard-coded value.
+ Otherwise, every element of the list affects the result. The list
+ /must/ be finite; the function will loop forever othewise.
+-}
+seed :: [Word32] -> Seed
+seed = foldr f seed0
+ where
+ f i (Seed w1 w2 w3 w4 c) = Seed w2 w3 w4 (w1 `xor` i) c
+
+{- |
+ Given an initial 'Seed' value, return a random 'Word32' and a new
+ 'Seed' value.
+
+ The 'Word32' value is chosen psuedo-randomly (i.e., the same 'Seed'
+ is guaranteed to always yield the same choice) with uniform
+ distribution (i.e., all possibilities equally likely) over the
+ complete range from 0x00000000 to 0xFFFFFFFF inclusive.
+-}
+next_word :: Seed -> (Word32, Seed)
+next_word (Seed w1 w2 w3 w4 c) =
+ let
+ new = magic * (fromIntegral w4) + (fromIntegral c)
+ lo = fromIntegral $ new
+ hi = fromIntegral $ new `shift` (-32)
+ in (lo, Seed lo w1 w2 w3 hi)
diff --git a/Random/MWC/Pure.hs b/Random/MWC/Pure.hs
new file mode 100644
index 0000000..16b0bea
--- /dev/null
+++ b/Random/MWC/Pure.hs
@@ -0,0 +1,287 @@
+{- |
+ Pure functions for random number generation.
+-}
+
+module Random.MWC.Pure
+ (
+ -- * Random seed
+ Seed (), seed,
+
+ -- * Random number generation
+ BoundedRandom (..), UnitRandom (..), RangeRandom (..),
+ random_list,
+ )
+ where
+
+import Data.Bits
+import Data.Word
+import Data.Int
+
+import Random.MWC.Primitive
+
+---------------------------------------------------------------------
+
+{- |
+ Class of things that can be chosen at random over their entire
+ value range. This requires that the range of possible values is
+ actually limited.
+-}
+class Bounded x => BoundedRandom x where
+ {- |
+ Given a 'Seed', return a randomly-chosen value and a new 'Seed'
+ value.
+
+ The value is chosen psuedo-randomly (the same 'Seed' will always
+ yield the same choice), with uniform distribution (all values
+ equally likely). The range of possible values is from 'minBound'
+ to 'maxBound' inclusive.
+ -}
+ bounded_random :: Seed -> (x, Seed)
+
+{- |
+ Class of things that can be chosen at random over the interval from
+ zero to one. This requires that \"zero\" and \"one\" are meaningful
+ concepts for this type, and also that the type is ordered. (Also,
+ there must be values /between/ zero and one, which rules out
+ integral types.)
+-}
+class Ord x => UnitRandom x where
+ {- |
+ Given a 'Seed', return a randomly-chosen value and a new 'Seed'
+ value.
+
+ The value is chosen psuedo-randomly (the same 'Seed' will always
+ yield the same choice), with uniform distribution (all values
+ equally likely). The range of possible values is from \"zero\" to
+ \"one\" inclusive.
+ -}
+ unit_random :: Seed -> (x, Seed)
+
+{- |
+ Class of things that can be chosen at random over a specified
+ interval. This requires that the type is ordered.
+-}
+class Ord x => RangeRandom x where
+ {- |
+ Given a 'Seed', return a randomly-chosen value and a new 'Seed'
+ value.
+
+ The value is chosen psuedo-randomly (the same 'Seed' will always
+ yield the same choice), with uniform distribution (all values
+ equally likely). The range is given by the first argument, which
+ specifies the lower and upper bounds (inclusive).
+ -}
+ range_random :: (x, x) -> Seed -> (x, Seed)
+
+{- |
+ Given a function to generate one random item, generate a list of
+ random items (of the specified length).
+-}
+random_list :: (Seed -> (x, Seed)) -> Int -> Seed -> ([x], Seed)
+random_list f n s
+ | n < 0 = error "Random.MWC.random_list: negative length"
+ | n == 0 = ([], s)
+ | otherwise =
+ let
+ (x , s' ) = f s
+ (xs, s'') = random_list f (n-1) s'
+ in (x:xs, s'')
+
+---------------------------------------------------------------------
+
+instance BoundedRandom Bool where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (odd x, s')
+
+instance BoundedRandom Word8 where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+instance BoundedRandom Word16 where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+instance BoundedRandom Word32 where
+ bounded_random = next_word
+
+instance BoundedRandom Word64 where
+ bounded_random s0 =
+ let
+ (x1, s1) = next_word s0
+ (x2, s2) = next_word s1
+ w1 = fromIntegral x1
+ w2 = fromIntegral x2
+ in (w1 `shift` 32 .|. w2, s2)
+
+instance BoundedRandom Int8 where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+instance BoundedRandom Int16 where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+instance BoundedRandom Int32 where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+instance BoundedRandom Int64 where
+ bounded_random s =
+ let (x, s') = bounded_random s :: (Word64, Seed)
+ in (fromIntegral x, s')
+
+-- This will go wrong if Int is wider than 32 bits.
+instance BoundedRandom Int where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+-- This will go wrong if Word is wider than 32 bits.
+instance BoundedRandom Word where
+ bounded_random s =
+ let (x, s') = next_word s
+ in (fromIntegral x, s')
+
+---------------------------------------------------------------------
+
+instance UnitRandom Float where
+ unit_random s =
+ let
+ (x, s') = next_word s
+ magic = 2**(-32) :: Float
+ in (magic * fromIntegral x, s')
+
+instance UnitRandom Double where
+ unit_random s =
+ let
+ (x, s') = bounded_random s :: (Word64, Seed)
+ magic = 2**(-64) :: Double
+ in (magic * fromIntegral x, s')
+
+---------------------------------------------------------------------
+
+instance RangeRandom Float where
+ range_random (x0, x1) s =
+ let (x, s') = unit_random s
+ in ((x1-x0)*x + x0, s')
+
+instance RangeRandom Double where
+ range_random (x0, x1) s =
+ let (x, s') = unit_random s
+ in ((x1-x0)*x + x0, s')
+
+instance RangeRandom Word8 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Word16 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Word32 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Word64 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Int8 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Int16 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Int32 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Int64 where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Int where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
+
+instance RangeRandom Word where
+ range_random (x0, x1) s =
+ let
+ dx = x1 - x0
+ (x, s') = bounded_random s
+ (xa, xb) = x `divMod` dx
+ in
+ if (xa+1)*dx < xa*dx
+ then range_random (x0, x1) s'
+ else (xb + x0, s')
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..833b4c6
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain