Okay, I figured the immutability bit out and I got the IORef example working, but I can't get it to work with state.

> put (pureMT 0) >>= runRVar flipCoin

gives me two type errors: "No instance for (MonadState PureMT m)" and "No instance for (RandomSource m ())"

> runState $ put (pureMT 0) >>= runRVar flipCoin
> runState $ put (pureMT 0) >> get >>= runRVar flipCoin
> put (pureMT 0) >> get >>= runRVar flipCoin

and other desperate attempts, some of which in hindsight are too embarrassing to list give me similar errors.  I'm trying to do figure out how to do this without going to the IO monad (so I can run it with the same seed to replicate results).

On Tue, Sep 7, 2010 at 3:14 PM, James Andrew Cook <mokus@deepbondi.net> wrote:
A PureMT generator is immutable, so must be threaded through the monad in which you are sampling.  There are RandomSource instances provided for a few special cases, including "IORef PureMT" in the IO monad.  For example:

main = do
   mt <- newPureMT
   src <- newIORef mt
   flips <- runRVar (replicateM 20 flipCoin) src
   print flips

Alternatively, the functions in the module you mentioned can be used to define additional instances, such as:

instance MonadRandom (State PureMT) where
   supportedPrims _ _ = True
   getSupportedRandomPrim = getRandomPrimFromPureMTState

And RandomSource instances look almost the same.  See the Data.Random.Source.PureMT source for examples.  (I thought I had included this particular instance in the distribution but I apparently missed it.  The next release will probably include this as well as corresponding instances for the 'transformers' package, possibly separated out into 'random-fu-mtl' and 'random-fu-transformers' packages).

The "StdRandom" type is a convenient "RandomSource" designating this instance in the State PureMT monad.  Personally, I prefer to use the "sample" function for this purpose, as well as the "sampleFrom" function in place of runRVar/runRVarT.  GHCi does not display the "sample" functions' types properly - they are defined for RVarT as well as for all Distribution instances.

Sorry it took so long responding.

-- James

On Sep 2, 2010, at 10:01 AM, Alex Rozenshteyn wrote:

> I seem to be having confusion at the runRVar level of random-fu.
>
> I can't figure out how to use the Data.Random.Source.PureMT module to get a meaningful random source (I can't get my code to type-check).
>
> I wrote a [trivial] flipCoin function
> > flipCoin = uniform False True
> and am trying to fill in the final place of runRVar
> > :t runRVar (replicateM 20 flipCoin)
> runRVar (replicateM 20 flipCoin)
>   :: (RandomSource m s) => s -> m [Bool]
>
>
> --
>           Alex R
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe




--
          Alex R