Because it’s what all the cool kids do, this is a post in literate Haskell. Assuming wordpress doesn’t screw things up too horribly, you should just be able to cut and paste it into your text editor and compile it.
How do you shuffle a pack of cards?
Easy. Throw it up in the air and then pick them up again. Done.
Ok, you don’t do that in practice, because it makes a mess. But in principle it would give you a fair shuffling of the cards. Conceptually it’s equivalent to doing “pick a card, any card” until you run out of cards, and using the resulting order you picked them in. But while tidy, that’s far too boring.
Nevertheless, it’s a pretty good way of shuffling. It’s more or less equivalent to one of the standard ways of shuffling a list/array/favourite sequential data structure, the Fisher-Yates shuffle. This has a very easy to follow imperative implementation, but the purely functional ones… not so much. Oleg has an implementation, although he doesn’t call it by this name. However, I found this implementation a little scary and (more importantly) not that easy to use.
Here’s one which is structured according to a custom monad (sorry) which emulates the “pick a card, any card” structure of shuffling the list. It seems likely that the monad has other uses, but I can’t think of any at the moment. Mostly I’m just posting this as a cute way to solve the problem.
>{-# LANGUAGE GeneralizedNewtypeDeriving#-}
We’ll need this to derive the monad instance for our sample.
> module Sample (
> Sample,
We’ll define a type Sample a b. This should be interpreted as an action which can add items to and random draw items from a bag of elements of type a and results in a b.
> takeSample,
Given a Sample we run it by providing it with a source of randomness.
We define a sample with the following primitives:
> draw,
We can draw an item from it at random. This returns Nothing if the bag is empty, else Just someItem
> place,
We can put an item into the bag.
> placeAll,
> drawAll,
And we provide some useful functions for bulk add and remove. placeAll puts a list of items into the bag. drawAll draws all the remaining items from the bag in a random order.
> shuffle
And using the combination of placeAll and drawAll we’ll define a shuffle function.
> ) where
>
> import Control.Monad.State
> import System.Random
> import qualified Data.Sequence as Seq
> import Data.Sequence (Seq, (<|), (|>), (><))
> newtype Sample a b = Sample (State (StdGen, Seq a) b) deriving Monad
A Sample consists of two things. A random generator with which to make choices and a collection of elements (we assume it’s a StdGen rather than an arbitrary generator, mainly because I’m being lazy) and a bag of elements to draw from. We allow repetitions, and in order to allow us to draw from any point we model it as a Data.Sequence rather than a list (which has O(log(k)) indexing).
We want to chain actions with respect to this sampling together, so we model it as a state monad.
> takeSample :: StdGen -> Sample a b -> b
> takeSample g (Sample st) = evalState st (g, Seq.empty)
Given a Sample, we set it running with a source of randomness and an empty bag.
> draw :: Sample a (Maybe a)
> draw = Sample $ do (gen, sample) <- get
> if (Seq.null sample)
> then return Nothing
> else do let (i, gen') = randomR (0, Seq.length sample - 1) gen
> let (x, sample') = remove i sample
> put (gen', sample')
> return $ Just x
Draw takes an element from the sequence, returns the result of that and chains through the new generator and the remaining elements.
> where
> remove :: Int -> Seq a -> (a, Seq a)
> remove 0 xs = (x, u) where (x Seq.:< u) = Seq.viewl xs
> remove i xs | i == Seq.length xs = (x, u) where (u Seq.:> x) = Seq.viewr xs
> remove i xs = (x, u >< v)
> where (u', v) = Seq.splitAt i xs
> (u Seq.:> x) = Seq.viewr u'
This is just a helpful method for removing an element from inside a sequence.
> place :: a -> Sample a ()
> place x = Sample $ do (gen, sample) <- get
> put (gen, x <| sample)
To place an element we just append it to the beginning of the sequence.
> placeAll :: [a] -> Sample a ()
> placeAll xs = Sample $ do (gen, sample) <- get
> put (gen, Seq.fromList xs >< sample)
Similarly for placing multiple elements, although we use sequence concatenation rather than appending them one by one.
> drawAll :: Sample a [a]
> drawAll = do el <- draw
> case el of
> Nothing -> return []
> Just(x) -> do xs <- drawAll
> return $ x : xs
drawAll simply draws from the bag until it finds nothing left. Pretty self explanatory.
> shuffle :: StdGen -> [a] -> [a]
> shuffle gen xs = takeSample gen $ placeAll xs >> drawAll
And finally, we can implement shuffle. And it’s a one liner. In order to shuffle a bunch of elements we simply put them all in the bag, then take them all out again in a random order. Ta da!
This wasn’t really very hard to do directly, but I found that creating the right abstraction to build it out of helped clarify the logic a lot.