AC-Random (empty) → 0.1

raw patch · 6 files changed

+518/−0 lines, 6 filesdep +basesetup-changed

Dependencies added: base

Files

• AC-Random.cabal +53/−0
• License.txt +30/−0
• Random/MWC/Monadic.hs +82/−0
• Random/MWC/Primitive.hs +64/−0
• Random/MWC/Pure.hs +287/−0
• Setup.hs +2/−0

@@ -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.*

@@ -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.

@@ -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

@@ -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)

@@ -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')

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