Merge pull request #37 from hdgarrood/stack-safe-gen-6

Stack safe gen (StateT)

Author: garyb

bower.json

@@ -24,6 +24,7 @@
     "purescript-exceptions": "^0.3.0",
     "purescript-lists": "^0.7.0",
     "purescript-random": "^0.2.0",
-    "purescript-strings": "^0.7.0"
+    "purescript-strings": "^0.7.0",
+    "purescript-transformers": "^0.6.1"
   }
 }

docs/Test/QuickCheck/Gen.md

@@ -20,33 +20,16 @@ type GenState = { newSeed :: Seed, size :: Size }
 
 The state of the random generator monad
 
-#### `GenOut`
-
-``` purescript
-type GenOut a = { state :: GenState, value :: a }
-```
-
-The output of the random generator monad
-
 #### `Gen`
 
 ``` purescript
-data Gen a
+type Gen a = State GenState a
 ```
 
 The random generator monad
 
 `Gen` is a state monad which encodes a linear congruential generator.
 
-##### Instances
-``` purescript
-instance functorGen :: Functor Gen
-instance applyGen :: Apply Gen
-instance applicativeGen :: Applicative Gen
-instance bindGen :: Bind Gen
-instance monadGen :: Monad Gen
-```
-
 #### `repeatable`
 
 ``` purescript
@@ -139,6 +122,14 @@ arrayOf1 :: forall a. Gen a -> Gen (Tuple a (Array a))
 
 Create a random generator which generates a non-empty array of random values.
 
+#### `listOf`
+
+``` purescript
+listOf :: forall a. Int -> Gen a -> Gen (List a)
+```
+
+Create a random generator which generates a list of random values of the specified size.
+
 #### `vectorOf`
 
 ``` purescript
@@ -159,7 +150,7 @@ uniform probability.
 #### `runGen`
 
 ``` purescript
-runGen :: forall a. Gen a -> GenState -> GenOut a
+runGen :: forall a. Gen a -> GenState -> Tuple a GenState
 ```
 
 Run a random generator

src/Test/QuickCheck/Gen.purs

@@ -3,7 +3,6 @@
 module Test.QuickCheck.Gen
   ( Gen()
   , GenState()
-  , GenOut()
   , Size()
   , repeatable
   , stateful
@@ -16,6 +15,7 @@ module Test.QuickCheck.Gen
   , frequency
   , arrayOf
   , arrayOf1
+  , listOf
   , vectorOf
   , elements
   , runGen
@@ -31,14 +31,19 @@ import Prelude
 
 import Control.Monad.Eff (Eff())
 import Control.Monad.Eff.Random (RANDOM())
+import Control.Monad.State (State(..), runState, evalState)
+import Control.Monad.State.Class (state, modify)
+import Control.Monad.Rec.Class (MonadRec, tailRecM)
 import Data.Array ((!!), length, range)
+import Data.Tuple (Tuple(..))
 import Data.Foldable (fold)
 import Data.Int (fromNumber, toNumber)
 import Data.Maybe (fromMaybe)
 import Data.Monoid.Additive (Additive(..), runAdditive)
 import Data.Traversable (sequence)
 import Data.Tuple (Tuple(..), fst, snd)
-import Data.List (List(..))
+import Data.Either (Either(..))
+import Data.List (List(..), fromList)
 import Test.QuickCheck.LCG
 import qualified Math as M
 
@@ -49,33 +54,30 @@ type Size = Int
 -- | The state of the random generator monad
 type GenState = { newSeed :: Seed, size :: Size }
 
--- | The output of the random generator monad
-type GenOut a = { state :: GenState, value :: a }
-
 -- | The random generator monad
 -- |
 -- | `Gen` is a state monad which encodes a linear congruential generator.
-data Gen a = Gen (GenState -> GenOut a)
+type Gen a = State GenState a
 
 -- | Create a random generator for a function type.
 repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
-repeatable f = Gen $ \s -> { value: \a -> (runGen (f a) s).value, state: s }
+repeatable f = state $ \s -> Tuple (\a -> fst (runGen (f a) s)) s
 
 -- | Create a random generator which uses the generator state explicitly.
 stateful :: forall a. (GenState -> Gen a) -> Gen a
-stateful f = Gen (\s -> runGen (f s) s)
+stateful f = state $ \s -> runGen (f s) s
 
 -- | Modify a random generator by setting a new random seed.
 variant :: forall a. Seed -> Gen a -> Gen a
-variant n g = Gen $ \s -> runGen g s { newSeed = n }
+variant n g = state $ \s -> runGen g s { newSeed = n }
 
 -- | Create a random generator which depends on the size parameter.
 sized :: forall a. (Size -> Gen a) -> Gen a
 sized f = stateful (\s -> f s.size)
 
 -- | Modify a random generator by setting a new size parameter.
 resize :: forall a. Size -> Gen a -> Gen a
-resize sz g = Gen $ \s -> runGen g s { size = sz }
+resize sz g = state $ \s -> runGen g s { size = sz }
 
 -- | Create a random generator which samples a range of `Number`s i
 -- | with uniform probability.
@@ -127,11 +129,21 @@ arrayOf1 g = sized $ \n ->
      xs <- vectorOf (k - one) g
      return $ Tuple x xs
 
+replicateMRec :: forall m a. (MonadRec m) => Int -> m a -> m (List a)
+replicateMRec k _ | k <= 0 = return Nil
+replicateMRec k gen = tailRecM go (Tuple Nil k)
+  where
+  go :: (Tuple (List a) Int) -> m (Either (Tuple (List a) Int) (List a))
+  go (Tuple acc 0) = return $ Right acc
+  go (Tuple acc n) = gen <#> \x -> Left (Tuple (Cons x acc) (n - 1))
+
+-- | Create a random generator which generates a list of random values of the specified size.
+listOf :: forall a. Int -> Gen a -> Gen (List a)
+listOf = replicateMRec
+
 -- | Create a random generator which generates a vector of random values of a specified size.
 vectorOf :: forall a. Int -> Gen a -> Gen (Array a)
-vectorOf k g
-  | k <= 0    = return []
-  | otherwise = sequence $ const g <$> range one k
+vectorOf k g = fromList <$> listOf k g
 
 -- | Create a random generator which selects a value from a non-empty collection with
 -- | uniform probability.
@@ -141,12 +153,12 @@ elements x xs = do
   pure if n == zero then x else fromMaybe x (xs !! (n - one))
 
 -- | Run a random generator
-runGen :: forall a. Gen a -> GenState -> GenOut a
-runGen (Gen f) = f
+runGen :: forall a. Gen a -> GenState -> Tuple a GenState
+runGen = runState
 
 -- | Run a random generator, keeping only the randomly-generated result
 evalGen :: forall a. Gen a -> GenState -> a
-evalGen gen st = (runGen gen st).value
+evalGen = evalState
 
 -- | Sample a random generator
 sample :: forall r a. Seed -> Size -> Gen a -> Array a
@@ -164,8 +176,8 @@ randomSample = randomSample' 10
 
 -- | A random generator which simply outputs the current seed
 lcgStep :: Gen Int
-lcgStep = Gen f where
-  f s = { value: runSeed s.newSeed, state: s { newSeed = lcgNext s.newSeed } }
+lcgStep = state f where
+  f s = Tuple (runSeed s.newSeed) (s { newSeed = lcgNext s.newSeed })
 
 -- | A random generator which approximates a uniform random variable on `[0, 1]`
 uniform :: Gen Number
@@ -175,25 +187,8 @@ 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 = perturb s.newSeed })
+perturbGen n gen = do
+  modify \s -> s { newSeed = perturb s.newSeed }
+  gen
   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
-    { value = value, state = state } -> { value: f value, state: state }
-
-instance applyGen :: Apply Gen where
-  apply (Gen f) (Gen x) = Gen $ \s ->
-    case f s of
-      { value = f', state = s' } -> case x s' of
-        { value = x', state = s'' } -> { value: f' x', state: s'' }
-
-instance applicativeGen :: Applicative Gen where
-  pure a = Gen (\s -> { value: a, state: s })
-
-instance bindGen :: Bind Gen where
-  bind (Gen f) g = Gen $ \s -> case f s of
-    { value = value, state = state } -> runGen (g value) state
-
-instance monadGen :: Monad Gen

test/Main.purs

@@ -0,0 +1,26 @@
+
+module Test.Main where
+
+import Prelude
+import Control.Bind
+import Data.Array (head)
+import Data.Maybe.Unsafe (fromJust)
+import Data.Foldable
+import Test.QuickCheck.Gen
+import Test.QuickCheck.Arbitrary
+import Control.Monad.Eff.Console
+
+main = do
+  log "Try with some little Gens first"
+  print =<< go 10
+  print =<< go 100
+  print =<< go 1000
+  print =<< go 10000
+
+  log "Testing stack safety of Gen"
+  print =<< go 20000
+  print =<< go 100000
+
+  where
+  go n = map (sum <<< unsafeHead) $ randomSample' 1 (vectorOf n (arbitrary :: Gen Int))
+  unsafeHead = fromJust <<< head