random-shuffle-0.0.4/0000755000000000000000000000000011770124543012617 5ustar0000000000000000random-shuffle-0.0.4/LICENSE0000644000000000000000000000301411770124543013622 0ustar0000000000000000Copyright (c) 2009 Oleg Kiselyov, Manlio Perillo (manlio.perillo@gmail.com) Portions by Oleg Kiselyov are in Public Domain. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. random-shuffle-0.0.4/random-shuffle.cabal0000644000000000000000000000146211770124543016520 0ustar0000000000000000cabal-version: >= 1.6 build-type: Simple name: random-shuffle version: 0.0.4 license: BSD3 license-file: LICENSE category: System author: Oleg Kiselyov, Manlio Perillo, Andras Slemmer maintainer: Manlio Perillo copyright: Oleg Kiselyov 2001 Manlio Perillo 2009 synopsis: Random shuffle implementation. description: Random shuffle implementation, on immutable lists. Based on `perfect shuffle' implementation by Oleg Kiselyov, available on http://okmij.org/ftp/Haskell/perfect-shuffle.txt stability: Beta library build-depends: base < 5, random, MonadRandom exposed-modules: System.Random.Shuffle hs-source-dirs: src ghc-options: -Wall random-shuffle-0.0.4/Setup.hs0000644000000000000000000000005711770124543014255 0ustar0000000000000000import Distribution.Simple main = defaultMain random-shuffle-0.0.4/src/0000755000000000000000000000000011770124543013406 5ustar0000000000000000random-shuffle-0.0.4/src/System/0000755000000000000000000000000011770124543014672 5ustar0000000000000000random-shuffle-0.0.4/src/System/Random/0000755000000000000000000000000011770124543016112 5ustar0000000000000000random-shuffle-0.0.4/src/System/Random/Shuffle.hs0000644000000000000000000000742111770124543020046 0ustar0000000000000000-- | -- Module : System.Random.Shuffle -- Copyright : (c) 2009 Oleg Kiselyov, Manlio Perillo -- License : BSD3 (see LICENSE file) -- -- 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 !a | Node !Int !(Tree a) !(Tree a) deriving Show -- Convert a sequence (e1...en) to a complete binary tree buildTree :: [a] -> Tree a buildTree = (fix growLevel) . (map Leaf) where growLevel _ [node] = node growLevel self l = self $ inner l inner [] = [] inner [e] = [e] inner (e1 : e2 : es) = e1 `seq` e2 `seq` (join e1 e2) : inner es join l@(Leaf _) r@(Leaf _) = Node 2 l r join l@(Node ct _ _) r@(Leaf _) = Node (ct + 1) l r join l@(Leaf _) r@(Node ct _ _) = Node (ct + 1) l r join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl + ctr) l r -- |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. shuffle :: [a] -> [Int] -> [a] shuffle elements = shuffleTree (buildTree elements) where shuffleTree (Leaf e) [] = [e] 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. 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) = let (e, r') = extractTree (n - 1) r in (e, Node (c - 1) (Leaf l) r') extractTree n (Node n' l (Leaf e)) | n + 1 == n' = (e, l) extractTree n (Node c l@(Node cl _ _) r) | n < cl = let (e, l') = extractTree n l 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 -- generator, compute the corresponding permutation of the input -- sequence. shuffle' :: RandomGen gen => [a] -> Int -> gen -> [a] shuffle' elements len = shuffle elements . rseq len where -- The sequence (r1,...r[n-1]) of numbers such that r[i] is an -- independent sample from a uniform random distribution -- [0..n-i] rseq :: RandomGen gen => Int -> gen -> [Int] rseq n = fst . unzip . rseq' (n - 1) where rseq' :: RandomGen gen => Int -> gen -> [(Int, gen)] rseq' 0 _ = [] 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))