More Random fun

Sep 6, 2007 at 5:37 PM
1 comment

The next obvious functions after “Pick” are “Unpick” to eject a value randomly from the list, and “Pick N” values from the list.

unpick is fairly straight-forward. To do in a single pass, you have to thread through the list of values, but otherwise it's more or less the same as the previous code for pick

 > unpick :: [a] -> IO [a]
 > unpick []     = undefined
 > unpick [x]    = do return []
 > unpick (x:xs) = do zs <- unpick' [] [x] xs 2
 >                    return (reverse zs)
 > 
 > unpick' :: (Num p, Random p) => [t] -> [t] -> [t] -> p -> IO [t]
 > unpick' curr orig [] _
 >     = do return curr
 > unpick' curr orig (next:rest) prob
 >     = do r <- getStdRandom (randomR (1,prob))
 >          let curr' = if r == 1 then orig else (next:curr)
 >          unpick' curr' (next:orig) rest (prob+1)

To do pickN I'd originally thought of picking the required number, and then following an algorithm similar to that of pick but dropping one (with unpick) every time I selected a new entry. That would be quadratic, and also insane. I discussed with dakkar, and we agreed that it might just be simpler to call something like pick N times (maybe with a function that returned the picked and the rejected part).

But, if we know the length of the array things are much easier. We can just scan the array, selecting elements with a probability of (r/e) where r is the number of required elements left to be selected, and e the number of elements left in the array.

 > pickN :: Int -> [a] -> IO [a]
 > pickN n xs = let len = length xs
 >              in  pickN' n len xs

And we just need

 > pickN' :: Int -> Int -> [a] -> IO [a]
 > pickN' n l []     = do return []
 > pickN' n l (x:xs) 
 >     = do b <- roll n l
 >          if b
 >            then x: (pickN' (n-1) (l-1) xs)
 >            else pickN' n (l-1) xs

and to define the auxhiliary function roll, because I got tired of writing it out all over the place:

 > roll p q = do r <- getStdRandom (randomR (1,q))
 >               return $ r <= p

Which is all great apart from not working. The problem is that pickN’ returns a monadic value, while x is a pure one. I asked on #haskell and got help from oerjan, scook0, and DRMacIver.

First of all they suggested:

 >        if b
 >           then (x:) `liftM` (pickN' (n-1) (l-1) xs)
 >           else pickN' n (l-1) xs

Now I intuitively sort-of-understood what this was doing but not why. (Bear in mind that I'm still confused about things like “why do I return this but not that?” and “How does it know which Monad it's in?”)

It turns out that liftM lifts a function with one pure argument into a function with one monadic argument. But I'm concatenating x (pure) with picked xs (monadic)! So the section (x:) is actually a pure function specialised to concatenate “x” with a pure list (which is the single argument).

My first reaction was a mix of wonder and “good god that's horrible”. As they pointed out though, I could just use another do block.

 >                      if b
 >                         then do xs <- pickN' (n-1) (l-1) xs
 >                                 return (x:xs)
 >                         else pickN' n (l-1) xs