How to create a tree of random values in Haskell?

Question

I've been working on learning about the state monad. I'm working with trees, defined as follows... data Tree a = Unary (Tree a) | Binary (Tree a) (Tree a)| Ternary (Tree a) (Tree a) (Tree a) | Leaf a

What I'm currently trying to do is make a function with type signature randomize :: Tree a -> Tree Int that returns a tree where each leaf (Leaf a) is replaced by a leaf (Leaf 0) or a (Leaf 1) with equal probability.

I previously wrote a function I called label :: Enum b => Tree a -> b -> Tree b that traverses a Tree and replaces every Leaf a with a Leaf b where b is incremented every time a leaf is visited. It is defined as follows

label:: Enum b => Tree a -> b -> Tree b
label tree b = evalState (mapSucc (\s -> (s, succ s)) tree) b where 
    mapSucc f (Leaf a) = Leaf <$> state f
    mapSucc f (Unary t1) = Unary <$> mapSucc f t1
    mapSucc f (Binary t1 t2) = Binary <$> mapSucc f t1 <*> mapSucc f t2
    mapSucc f (Ternary t1 t2 t3) = Ternary <$> mapSucc f t1 <*> mapSucc f t2 <*> mapSucc f t3

These seem to be very similar problems, you are weaving the state through each, you're just producing values differently. I tried...

randomize tree = evalState ( mapRandom (randomR (0,1)) tree) newStdGen  where 
    mapRandom f (Leaf a) = Leaf <$> state f
    mapRandom f (Unary t1) = Unary <$> mapRandom f t1
    mapRandom f (Binary t1 t2) = Binary <$> mapRandom f t1 <*> mapRandom f t2
    mapRandom f (Ternary t1 t2 t3) = Ternary <$> mapRandom f t1 <*> mapRandom f t2 <*> mapRandom f t3

however the compiler gave me the following

state.hs:55:41: error:
    • No instance for (RandomGen (IO StdGen))
        arising from a use of ‘randomR’
    • In the first argument of ‘mapRandom’, namely ‘(randomR (0, 1))’
      In the first argument of ‘evalState’, namely
        ‘(mapRandom (randomR (0, 1)) tree)’
      In the expression:
        evalState (mapRandom (randomR (0, 1)) tree) newStdGen

I thought Int was an instance of random, so I'm not really sure what to do to get an instance of Random, and if I did manage that if my thought process is on the right path. Would my solution work if I were to get an instance of random. I guess I'm not sure if my shortcoming stems from simply not knowing how to use System.Random or if I am not understanding the type of function I need. I've spent a significant amount of time trying to make randomize work but to no avail. Any help with understanding would be greatly appreciated.

Answer 1

From the compiler error message, it seems the problem is caused by the fact that your random number generator comes wrapped in the IO monad, because you have used function newStdGen.

You can get an unwrapped generator by using function mkStdGen instead. This function takes a parameter of Type Int as the seed of the generator.

For example, this code compiles:

randomize :: (Random a, Num a) => Int -> Tree a -> Tree a
randomize seed tree = evalState ( mapRandom (randomR (0,1)) tree) (mkStdGen seed)  where 
    mapRandom f (Leaf a) = Leaf <$> state f
    mapRandom f (Unary t1) = Unary <$> mapRandom f t1
    mapRandom f (Binary t1 t2) = Binary <$> mapRandom f t1 <*> mapRandom f t2
    mapRandom f (Ternary t1 t2 t3) = Ternary <$> mapRandom f t1
                                     <*> mapRandom f t2 <*> mapRandom f t3

and you get as a bonus the possibility to reproduce the same sequence of random numbers at will (by passing the same seed again), something that newStdGen does not provide.

Function newStdGen uses the system clock to generate the seed, hence the need to involve the IO monad.

Addendum:

How to avoid duplicating the tree traversal code

Function randomize above works. However, it is not entirely satisfactory: it involves the algorithm for tree traversal, and it decides which range of values to use, and also which type of random number generator. So it seems to fail something known in computer programming as the Single Responsibility Principle (SRP).

One might need a different range some day. Also, you can make a case that the Threefish random number generator has better statistical properties than the standard Haskell one, and wish to use its Haskell implementation.

The path of least resistance is to clone the code for randomize and replace mkStdGen by mkTFGen. But at that point, the tree traversal code gets duplicated. And there are many potential duplicates. We should find a better way.

The general problem is to produce a new version of the initial tree using a stateful mapping. Here, we have so far ignored the values in the initial tree, but this is just for the particular case of a random output tree.

Generally, the type signature of the required transformation function would have to be:

statefulTreeMap :: (a -> s -> (b,s))  ->  s  ->  Tree a  ->  (Tree b, s)

where s is the type of the state. In the case of randomize, the state is just (the current state of) the random number generator.

You can easily write the code for statefulTreeMap manually, using clauses like this:

statefulTreeMap step st0 (Binary tra1 tra2) =
    let  (trb1, st1) = statefulTreeMap step st0 tra1
         (trb2, st2) = statefulTreeMap step st1 tra2
    in  (Binary trb1 trb2 , st2)

But this is not really the most Haskellish way.

It turns out this is quite similar to the mapAccumL library function. And the Haskell language library makes mapAccumL available for any entity belonging to the Traversable typeclass. Note that @amalloy mentions the Traversable typeclass in one of the comments.

So we could try to make our Tree type an instance of Traversable, and then make use of function mapAccumL.

This can be done by providing the code for function traverse explicitely:

instance Traversable Tree  where
    traverse fn (Unary ta)          =  Unary    <$>  (traverse fn ta)
    traverse fn (Binary ta tb)      =  Binary   <$>  (traverse fn ta) <*> (traverse fn tb)
    traverse fn (Ternary ta tb tc)  =  Ternary  <$>  (traverse fn ta) <*> (traverse fn tb) <*> (traverse fn tc)
    traverse fn (Leaf a)            =  Leaf <$> fn a

But this is not even necessary. Instead, one can summon the compiler heavy artillery (at least in recent enough versions), and just ask it to generate the Tree version of traverse, by enabling the DeriveTraversable language extension:

{-#  LANGUAGE  DeriveFunctor         #-}
{-#  LANGUAGE  DeriveFoldable        #-}
{-#  LANGUAGE  DeriveTraversable     #-}

import qualified  Data.Tuple        as  T
import qualified  Data.Traversable  as  TR
import  System.Random
import qualified  System.Random.TF  as  TF
import  Control.Monad.State


data Tree a = Unary (Tree a)  |  Binary (Tree a) (Tree a)  |
              Ternary (Tree a) (Tree a) (Tree a)  |  Leaf a
                deriving  (Eq, Show, Functor, Foldable, Traversable)

Then we can have a generic version of our target statefulTreeMap function by putting some plumbing code around the mapAccumL function we've just got for free:

-- general solution for any Traversable entity:
statefulMap :: Traversable tr => (a -> s -> (b,s)) -> s -> tr a -> (tr b, s)
statefulMap step st0 tra =
    let  fn = \s y -> T.swap (step y s)
         p  = TR.mapAccumL fn st0 tra -- works in reverse if using mapAccumR
    in
         T.swap p

and we can immediately specialize it for Tree objects:

statefulTreeMap :: (a -> s -> (b,s)) -> s -> Tree a -> (Tree b, s)
statefulTreeMap = statefulMap

Thus we're almost done. We can now write a number of versions of randomize by supplying more plumbing code:

-- generic random tree generation, with range and generator as external parameters:
randomize2 :: (RandomGen gt, Random b, Num b)  =>  (b,b) -> gt -> Tree a -> Tree b
randomize2 range gen tra =
    let  step = (\a g -> randomR range g)        -- leftmost parameter ignored
    in   fst $ statefulTreeMap  step  gen  tra   -- drop final state of rng

-- version taking just a seed, with output range and generator type both hardwired:
randomize3 :: (Random b, Num b) => Int -> Tree a -> Tree b
randomize3 seed tra  =  let  rng   = TF.mkTFGen seed
                             range = (0,9)
                        in   randomize2  range  rng  tra

Test code:

main = do
    let  seed = 4243
         rng0 = TF.mkTFGen seed
         tr1  = Ternary  (Ternary (Leaf 1) (Leaf 2) (Leaf 3))
                         (Leaf (4::Integer))
                         (Binary  (Leaf 12) (Leaf 13))

         tr11 = (randomize    seed       tr1)  :: Tree Integer
         tr12 = (randomize2  (0,9) rng0  tr1)  :: Tree Integer
         tr13 = (randomize3   seed       tr1)  :: Tree Integer

    putStrLn $ "tr1   =  " ++ (show tr1) ++ "\n"
    putStrLn $ "tr11  =  " ++ (show tr11)
    putStrLn $ "tr12  =  " ++ (show tr12)
    putStrLn $ "tr13  =  " ++ (show tr13)

    putStrLn $ "tr11 == tr12  =  " ++ (show (tr11 == tr12))
    putStrLn $ "tr11 == tr13  =  " ++ (show (tr11 == tr13))

Program output:

tr1   =  Ternary (Ternary (Leaf 1) (Leaf 2) (Leaf 3)) (Leaf 4) (Binary (Leaf 12) (Leaf 13))

tr11  =  Ternary (Ternary (Leaf 9) (Leaf 6) (Leaf 0)) (Leaf 3) (Binary (Leaf 2) (Leaf 6))
tr12  =  Ternary (Ternary (Leaf 9) (Leaf 6) (Leaf 0)) (Leaf 3) (Binary (Leaf 2) (Leaf 6))
tr13  =  Ternary (Ternary (Leaf 9) (Leaf 6) (Leaf 0)) (Leaf 3) (Binary (Leaf 2) (Leaf 6))
tr11 == tr12  =  True
tr11 == tr13  =  True

So, in fact, we have eliminated the need for any explicit tree traversal code.

Side note:

Of course, the statefulTreeMap function can be used for tasks unrelated to pseudo-randomness. For example, we might want to give consecutive numbers to the elements of a Tree object:

enumerate :: Tree a -> Tree (a, Int)
enumerate = fst . (statefulTreeMap  (\a rs -> ((a, head rs), tail rs))  [0..])

Testing under ghci:

 λ> 
 λ> enumerate tr1
Ternary (Ternary (Leaf (1,0)) (Leaf (2,1)) (Leaf (3,2))) (Leaf (4,3)) (Binary (Leaf (12,4)) (Leaf (13,5)))
 λ> 

Answer 2

Your attempt was close. The problem is that newStdGen is an IO StdGen, but you need an StdGen. To fix that, change evalState ( mapRandom (randomR (0,1)) tree) newStdGen to evalState ( mapRandom (randomR (0,1)) tree) <$> newStdGen. Note that it'll then be randomize :: Tree a -> IO (Tree Int) rather than randomize :: Tree a -> Tree Int, but you can't avoid changing the type signature (your only other option is to make the StdGen be a parameter, which also changes it).