random-shuffle 0.0.2 → 0.0.4

raw patch · 2 files changed

Files

• random-shuffle.cabal +3/−3
• src/System/Random/Shuffle.hs +20/−8

@@ -1,11 +1,11 @@ cabal-version:    >= 1.6 build-type:       Simple name:             random-shuffle-version:          0.0.2+version:          0.0.4 license:          BSD3 license-file:     LICENSE category:         System-author:           Oleg Kiselyov, Manlio Perillo+author:           Oleg Kiselyov, Manlio Perillo, Andras Slemmer maintainer:       Manlio Perillo <manlio.perillo@gmail.com> copyright:        Oleg Kiselyov 2001                   Manlio Perillo 2009@@ -18,7 +18,7 @@ stability:        Beta  library-    build-depends:      base, random+    build-depends:      base < 5, random, MonadRandom     exposed-modules:    System.Random.Shuffle     hs-source-dirs:     src     ghc-options:        -Wall

@@ -5,23 +5,27 @@ -- -- http://okmij.org/ftp/Haskell/perfect-shuffle.txt --+{-# OPTIONS_GHC -funbox-strict-fields #-}  module System.Random.Shuffle     (      shuffle     , shuffle'+    , shuffleM     ) where  import Data.Function (fix) import System.Random (RandomGen, randomR)+import Control.Monad (liftM,liftM2)+import Control.Monad.Random (MonadRandom, getRandomR)   -- A complete binary tree, of leaves and internal nodes. -- Internal node: Node card l r -- where card is the number of leaves under the node. -- Invariant: card >=2. All internal tree nodes are always full.-data Tree a = Leaf {-# UNPACK #-} !a-            | Node {-# UNPACK #-} !Int !(Tree a) !(Tree a)+data Tree a = Leaf !a+            | Node !Int !(Tree a) !(Tree a)               deriving Show  @@ -42,7 +46,7 @@       join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl + ctr) l r  --- Given a sequence (e1,...en) to shuffle, and a sequence+-- |Given a sequence (e1,...en) to shuffle, and a sequence -- (r1,...r[n-1]) of numbers such that r[i] is an independent sample -- from a uniform random distribution [0..n-i], compute the -- corresponding permutation of the input sequence.@@ -53,16 +57,13 @@       shuffleTree tree (r : rs) =           let (b, rest) = extractTree r tree 	  in b : (shuffleTree rest rs)+      shuffleTree _ _ = error "[shuffle] called with lists of different lengths"        -- Extracts the n-th element from the tree and returns       -- that element, paired with a tree with the element       -- deleted.       -- The function maintains the invariant of the completeness       -- of the tree: all internal nodes are always full.-      -- NOTE: the collection of patterns below is deliberately not-      --       complete.-      --       All the missing cases may not occur-      --       (and if they do, that's an error).       extractTree 0 (Node _ (Leaf e) r) = (e, r)       extractTree 1 (Node 2 (Leaf l) (Leaf r)) = (r, Leaf l)       extractTree n (Node c (Leaf l) r) =@@ -77,8 +78,9 @@ 		     in (e, Node (c - 1) l' r) 	  | otherwise = let (e, r') = extractTree (n - cl) r 			in (e, Node (c - 1) l r')+      extractTree _ _ = error "[extractTree] impossible" --- Given a sequence (e1,...en) to shuffle, its length, and a random+-- |Given a sequence (e1,...en) to shuffle, its length, and a random -- generator, compute the corresponding permutation of the input -- sequence. shuffle' :: RandomGen gen => [a] -> Int -> gen -> [a]@@ -95,3 +97,13 @@             rseq' i gen = (j, gen) : rseq' (i - 1) gen'                 where                   (j, gen') = randomR (0, i) gen++-- |shuffle' wrapped in a random monad+shuffleM :: (MonadRandom m) => [a] -> m [a]+shuffleM elements+    | null elements = return []+    | otherwise     = liftM (shuffle elements) (rseqM (length elements - 1))+  where+    rseqM :: (MonadRandom m) => Int -> m [Int]+    rseqM 0 = return []+    rseqM i = liftM2 (:) (getRandomR (0, i)) (rseqM (i - 1))