Commits

Sergey Astanin  committed a64dc5b

Version 0.0.2 from Hackage.

  • Participants

Comments (0)

Files changed (4)

+Copyright (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.
+import Distribution.Simple
+
+main = defaultMain

File random-shuffle.cabal

+cabal-version:    >= 1.6
+build-type:       Simple
+name:             random-shuffle
+version:          0.0.2
+license:          BSD3
+license-file:     LICENSE
+category:         System
+author:           Oleg Kiselyov, Manlio Perillo
+maintainer:       Manlio Perillo <manlio.perillo@gmail.com>
+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, random
+    exposed-modules:    System.Random.Shuffle
+    hs-source-dirs:     src
+    ghc-options:        -Wall

File src/System/Random/Shuffle.hs

+-- |
+-- Module      : System.Random.Shuffle
+-- Copyright   : (c) 2009 Oleg Kiselyov, Manlio Perillo
+-- License     : BSD3 (see LICENSE file)
+--
+-- http://okmij.org/ftp/Haskell/perfect-shuffle.txt
+--
+
+module System.Random.Shuffle
+    (
+     shuffle
+    , shuffle'
+    ) where
+
+import Data.Function (fix)
+import System.Random (RandomGen, randomR)
+
+
+-- 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)
+              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)
+
+      -- 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) =
+	  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')
+
+-- 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