Merge pull request #34 from hdgarrood/adjust-lcg

Adjust LCG parameters

Author: garyb

docs/Test/QuickCheck.md

@@ -49,7 +49,7 @@ representing the number of tests which should be run.
 #### `quickCheckPure`
 
 ``` purescript
-quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> List Result
+quickCheckPure :: forall prop. (Testable prop) => Seed -> Int -> prop -> List Result
 ```
 
 Test a property, returning all test results as an array.

docs/Test/QuickCheck/Gen.md

@@ -172,21 +172,29 @@ evalGen :: forall a. Gen a -> GenState -> a
 
 Run a random generator, keeping only the randomly-generated result
 
-#### `showSample'`
+#### `sample`
 
 ``` purescript
-showSample' :: forall r a. (Show a) => Size -> Gen a -> Eff (console :: CONSOLE | r) Unit
+sample :: forall r a. Seed -> Size -> Gen a -> Array a
 ```
 
-Print a random sample to the console
+Sample a random generator
 
-#### `showSample`
+#### `randomSample'`
 
 ``` purescript
-showSample :: forall r a. (Show a) => Gen a -> Eff (console :: CONSOLE | r) Unit
+randomSample' :: forall r a. Size -> Gen a -> Eff (random :: RANDOM | r) (Array a)
 ```
 
-Print a random sample of 10 values to the console
+Sample a random generator, using a randomly generated seed
+
+#### `randomSample`
+
+``` purescript
+randomSample :: forall r a. Gen a -> Eff (random :: RANDOM | r) (Array a)
+```
+
+Get a random sample of 10 values
 
 #### `uniform`
 

docs/Test/QuickCheck/LCG.md

@@ -1,39 +1,36 @@
 ## Module Test.QuickCheck.LCG
 
-#### `Seed`
-
-``` purescript
-type Seed = Int
-```
-
 #### `lcgM`
 
 ``` purescript
 lcgM :: Int
 ```
 
-A magic constant for the linear congruential generator
+The *multiplier*: a magic constant for the linear congruential generator
 
 #### `lcgC`
 
 ``` purescript
 lcgC :: Int
 ```
 
-A magic constant for the linear congruential generator
+The *increment*: a magic constant for the linear congruential generator
 
 #### `lcgN`
 
 ``` purescript
 lcgN :: Int
 ```
 
-A magic constant for the linear congruential generator
+The *modulus*: a magic constant for the linear congruential generator.
+It is equal to 2^31 - 1, a Mersenne prime. It is useful for this value to
+be prime, because then the requirement of the initial seed being coprime
+to the modulus is satisfied when the seed is between 1 and lcgN - 1.
 
 #### `lcgNext`
 
 ``` purescript
-lcgNext :: Int -> Int
+lcgNext :: Seed -> Seed
 ```
 
 Step the linear congruential generator
@@ -46,4 +43,32 @@ randomSeed :: forall e. Eff (random :: RANDOM | e) Seed
 
 Create a random seed
 
+#### `Seed`
+
+``` purescript
+newtype Seed
+```
+
+A seed for the linear congruential generator. We omit a `Semiring`
+instance because there is no `zero` value, as 0 is not an acceptable
+seed for the generator.
+
+##### Instances
+``` purescript
+instance showSeed :: Show Seed
+instance eqSeed :: Eq Seed
+```
+
+#### `mkSeed`
+
+``` purescript
+mkSeed :: Int -> Seed
+```
+
+#### `runSeed`
+
+``` purescript
+runSeed :: Seed -> Int
+```
+
 

src/Test/QuickCheck.purs

@@ -65,7 +65,7 @@ quickCheck' n prop = do
 -- |
 -- | The first argument is the _random seed_ to be passed to the random generator.
 -- | The second argument is the number of tests to run.
-quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> List Result
+quickCheckPure :: forall prop. (Testable prop) => Seed -> Int -> prop -> List Result
 quickCheckPure s n prop = evalGen (replicateM n (test prop)) { newSeed: s, size: 10 }
 
 -- | The `Testable` class represents _testable properties_.

src/Test/QuickCheck/Gen.purs

@@ -22,14 +22,15 @@ module Test.QuickCheck.Gen
   , evalGen
   , perturbGen
   , uniform
-  , showSample
-  , showSample'
+  , sample
+  , randomSample
+  , randomSample'
   ) where
 
 import Prelude
 
 import Control.Monad.Eff (Eff())
-import Control.Monad.Eff.Console (CONSOLE(), print)
+import Control.Monad.Eff.Random (RANDOM())
 import Data.Array ((!!), length, range)
 import Data.Foldable (fold)
 import Data.Int (fromNumber, toNumber)
@@ -148,21 +149,23 @@ evalGen :: forall a. Gen a -> GenState -> a
 evalGen gen st = (runGen gen st).value
 
 -- | Sample a random generator
-sample :: forall r a. Size -> Gen a -> Array a
-sample sz g = evalGen (vectorOf sz g) { newSeed: zero, size: sz }
+sample :: forall r a. Seed -> Size -> Gen a -> Array a
+sample seed sz g = evalGen (vectorOf sz g) { newSeed: seed, size: sz }
 
--- | Print a random sample to the console
-showSample' :: forall r a. (Show a) => Size -> Gen a -> Eff (console :: CONSOLE | r) Unit
-showSample' n g = print $ sample n g
+-- | Sample a random generator, using a randomly generated seed
+randomSample' :: forall r a. Size -> Gen a -> Eff (random :: RANDOM | r) (Array a)
+randomSample' n g = do
+  seed <- randomSeed
+  return $ sample seed n g
 
--- | Print a random sample of 10 values to the console
-showSample :: forall r a. (Show a) => Gen a -> Eff (console :: CONSOLE | r) Unit
-showSample = showSample' 10
+-- | Get a random sample of 10 values
+randomSample :: forall r a. Gen a -> Eff (random :: RANDOM | r) (Array a)
+randomSample = randomSample' 10
 
 -- | A random generator which simply outputs the current seed
 lcgStep :: Gen Int
 lcgStep = Gen f where
-  f s = { value: s.newSeed, state: s { newSeed = lcgNext s.newSeed } }
+  f s = { value: runSeed s.newSeed, state: s { newSeed = lcgNext s.newSeed } }
 
 -- | A random generator which approximates a uniform random variable on `[0, 1]`
 uniform :: Gen Number
@@ -172,7 +175,9 @@ foreign import float32ToInt32 :: Number -> Int
 
 -- | Perturb a random generator by modifying the current seed
 perturbGen :: forall a. Number -> Gen a -> Gen a
-perturbGen n (Gen f) = Gen $ \s -> f (s { newSeed = lcgNext (float32ToInt32 n) + s.newSeed })
+perturbGen n (Gen f) = Gen $ \s -> f (s { newSeed = perturb s.newSeed })
+  where
+  perturb oldSeed = mkSeed (runSeed (lcgNext (mkSeed (float32ToInt32 n))) + runSeed oldSeed)
 
 instance functorGen :: Functor Gen where
   map f (Gen g) = Gen $ \s -> case g s of

src/Test/QuickCheck/LCG.purs

@@ -1,5 +1,7 @@
 module Test.QuickCheck.LCG
   ( Seed()
+  , mkSeed
+  , runSeed
   , lcgM
   , lcgC
   , lcgN
@@ -16,24 +18,57 @@ import Data.Int (fromNumber, toNumber)
 import Data.Int.Bits (shl)
 import qualified Data.Maybe.Unsafe as U
 
-type Seed = Int
-
--- | A magic constant for the linear congruential generator
+-- | The *multiplier*: a magic constant for the linear congruential generator
 lcgM :: Int
-lcgM = 1103515245
+lcgM = 48271
 
--- | A magic constant for the linear congruential generator
+-- | The *increment*: a magic constant for the linear congruential generator
 lcgC :: Int
-lcgC = 12345
+lcgC = 0
 
--- | A magic constant for the linear congruential generator
+-- | The *modulus*: a magic constant for the linear congruential generator.
+-- | It is equal to 2^31 - 1, a Mersenne prime. It is useful for this value to
+-- | be prime, because then the requirement of the initial seed being coprime
+-- | to the modulus is satisfied when the seed is between 1 and lcgN - 1.
 lcgN :: Int
-lcgN = one `shl` 30
+lcgN = 2147483647
 
 -- | Step the linear congruential generator
-lcgNext :: Int -> Int
-lcgNext n = U.fromJust $ fromNumber $ (toNumber lcgM * toNumber n + toNumber lcgC) % toNumber lcgN
+lcgNext :: Seed -> Seed
+lcgNext = Seed <<< go <<< runSeed
+  where
+  go n = U.fromJust $ fromNumber $ (toNumber lcgM * toNumber n + toNumber lcgC) % toNumber lcgN
 
 -- | Create a random seed
 randomSeed :: forall e. Eff (random :: RANDOM | e) Seed
-randomSeed = randomInt 0 lcgM
+randomSeed = mkSeed <$> randomInt seedMin seedMax
+
+-- | The minimum permissible Seed value.
+seedMin :: Int
+seedMin = 1
+
+-- | The maximum permissible Seed value.
+seedMax :: Int
+seedMax = lcgM - 1
+
+-- | A seed for the linear congruential generator. We omit a `Semiring`
+-- | instance because there is no `zero` value, as 0 is not an acceptable
+-- | seed for the generator.
+newtype Seed = Seed Int
+
+mkSeed :: Int -> Seed
+mkSeed x = Seed (ensureBetween seedMin seedMax x)
+
+runSeed :: Seed -> Int
+runSeed (Seed x) = x
+
+ensureBetween :: Int -> Int -> Int -> Int
+ensureBetween min max n =
+  let rangeSize = max - min
+  in (((n `mod` rangeSize) + rangeSize) `mod` rangeSize) + min
+
+instance showSeed :: Show Seed where
+  show (Seed x) = "Seed " <> show x
+
+instance eqSeed :: Eq Seed where
+  eq (Seed x) (Seed y) = eq x y