--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/haskell/Sample.lhs	Sun Apr 20 12:41:00 2008 +0100
@@ -0,0 +1,102 @@
+<p>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.</p>
+<p>How do you shuffle a pack of cards?</p>
+<p>Easy. Throw it up in the air and then pick them up again. Done.</p>
+<p>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.</p>
+<p>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 <a href="http://en.wikipedia.org/wiki/Fisher-Yates_shuffle">Fisher-Yates shuffle</a>. This has a very easy to follow imperative implementation, but the purely functional ones... not so much. Oleg <a href="http://okmij.org/ftp/Haskell/perfect-shuffle.txt">has an implementation</a>, 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.</p>
+<p>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.</p>
+
+>{-# LANGUAGE GeneralizedNewtypeDeriving#-} 
+
+<p>We'll need this to derive the monad instance for our sample.</p>
+
+> module Sample (
+>   Sample,
+
+<p>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. </p>
+
+>   takeSample, 
+
+<p>Given a Sample we run it by providing it with a source of randomness.</p>
+<p>We define a sample with the following primitives:</p>
+
+>   draw,
+
+<p>We can draw an item from it at random. This returns Nothing if the bag is empty, else Just someItem</p>
+
+>   place,
+
+<p>We can put an item into the bag.</p>
+
+>   placeAll,
+>   drawAll,
+
+<p>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.</p>
+
+> shuffle
+
+<p>And using the combination of placeAll and drawAll we'll define a shuffle function.</p>
+
+> ) 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
+
+<p>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).  </p>
+<p>We want to chain actions with respect to this sampling together, so we model it as a state monad.</p>
+
+> takeSample :: StdGen -> Sample a b -> b
+> takeSample g (Sample st) = evalState st (g, Seq.empty)
+
+<p>Given a Sample, we set it running with a source of randomness and an empty bag.</p>
+
+> 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
+
+<p>Draw takes an element from the sequence, returns the result of that and chains through the new generator and the remaining elements.</p>
+
+>  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' 
+
+<p>This is just a helpful method for removing an element from inside a sequence.</p>
+ 
+> place :: a -> Sample a ()
+> place x = Sample $ do (gen, sample) <- get
+>                       put (gen, x <| sample)
+
+<p>To place an element we just append it to the beginning of the sequence.</p>
+ 
+> placeAll :: [a] -> Sample a ()
+> placeAll xs = Sample $ do (gen, sample) <- get
+>                           put (gen, Seq.fromList xs >< sample)
+
+<p>Similarly for placing multiple elements, although we use sequence concatenation rather than appending them one by one.</p>
+ 
+> drawAll :: Sample a [a]
+> drawAll = do el <- draw
+>              case el of 
+>                   Nothing -> return []
+>                   Just(x) -> do xs <- drawAll
+>                                 return $ x : xs
+
+<p>drawAll simply draws from the bag until it finds nothing left. Pretty self explanatory.</p>
+
+> shuffle :: StdGen -> [a] -> [a]
+> shuffle gen xs = takeSample gen $ placeAll xs >> drawAll 
+
+<p>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!</p>
+
+<p>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. </p>