random-extras 0.11 → 0.15

raw patch · 4 files changed

+146/−40 lines, 4 files

Files

• Data/Random/Dovetail.hs +134/−0
• Data/Random/Extras.hs +1/−1
• README +6/−0
• random-extras.cabal +5/−39

@@ -0,0 +1,134 @@+{-# LANGUAGE FlexibleContexts #-}++{- |+Module       : Data.Random.Extras+Copyright    : 2010 Aristid Breitkreuz+License      : BSD3+Stability    : experimental+Portability  : portable++Functions for splitting a deck of cards like game players.++Decks are represented by 'Seq's, because these efficiently support the required operations.++[See:] Bayer, Diaconis /Trailing the Dovetail Shuffle to its Lair/ <http://projecteuclid.org/euclid.aoap/1177005705>+-}++module Data.Random.Dovetail+(+  -- * Splitting decks+  splitDeck+, generalizedSplitDeck+  -- * Riffling decks together+, riffleDecks+, generalizedRiffleDecks+  -- ** Inverse riffling+, inverseRiffleDecks+, generalizedInverseRiffleDecks+  -- * Dovetail shuffling+, dovetail+, generalizedDovetail+  -- ** Repeated dovetail shuffling+, dovetails+, generalizedDovetails+  -- ** Inverse dovetail shuffling+, inverseDovetail+, generalizedInverseDovetail+)+where+  +import Control.Applicative ((<$>))+import Control.Monad+import Data.Random.RVar  +import Data.Random.Distribution.Binomial+import Data.Random.Distribution.Uniform+import Data.Foldable (foldr1)+import Data.Sequence hiding (replicateM)+import Prelude hiding (null, length, splitAt, replicate, foldr1)++-- | Split a deck into two /roughly equal/ halves.+splitDeck :: Seq a -> RVar (Seq a, Seq a)+splitDeck s = flip splitAt s <$> binomial (length s) (0.5 :: Double)++-- | Split a deck into /n/ /roughly equal/ parts.+generalizedSplitDeck :: Int -> Seq a -> RVar [Seq a]+generalizedSplitDeck n s = split s <$> replicateM (n - 1) bin+    where bin = binomial (length s) (1 / fromIntegral n :: Double)+          split t []     = [t]+          split t (p:ps) = let (l, r) = splitAt p t in+                           l : split r ps++-- | Riffle two halves of a deck into one deck.+riffleDecks :: Seq a -> Seq a -> RVar (Seq a)+riffleDecks a b | null a = return b+                | null b = return a+                | otherwise = deterministicRiffle =<< uniform 1 len+    where lenA = length a+          lenB = length b+          len = lenA + lenB+          deterministicRiffle n | n <= lenA =+                                    let (a1 :< as) = viewl a in+                                    (a1 <|) <$> riffleDecks as b+                                | otherwise =+                                    let (b1 :< bs) = viewl b in+                                    (b1 <|) <$> riffleDecks a bs++-- | Riffle /n/ parts into one deck.+generalizedRiffleDecks :: [Seq a] -> RVar (Seq a)+generalizedRiffleDecks []     = return empty+generalizedRiffleDecks (x:xs) = riffleDecks x =<< generalizedRiffleDecks xs++-- | Perform an inverse riffle, i.e. letting the cards from a deck drop +-- randomly into two heaps.+inverseRiffleDecks :: Seq a -> RVar (Seq a, Seq a)+inverseRiffleDecks s | null s    = return (empty, empty)+                     | otherwise = let (s1 :< ss) = viewl s in+                                   liftM2 (unriffle s1) (inverseRiffleDecks ss) (uniform False True)+    where unriffle a (l, r) left = case left of+                                     True  -> (a <| l, r)+                                     False -> (l, a <| r)++-- | Perform an inverse riffle, i.e. letting the cards from a deck drop+-- randomly into /n/ heaps.+generalizedInverseRiffleDecks :: Int -> Seq a -> RVar (Seq (Seq a))+generalizedInverseRiffleDecks n s | null s    = return $ replicate n empty+                                  | otherwise = liftM2 (unriffle s1) next (uniform 0 (n - 1))+    where unriffle a t i = adjust (a <|) i t+          (s1 :< ss) = viewl s+          next = generalizedInverseRiffleDecks n ss++-- | Dovetail shuffle a deck, i.e. split the deck with splitDeck and riffle +-- the resulting halves with 'riffleDecks'.+dovetail :: Seq a -> RVar (Seq a)+dovetail s = uncurry riffleDecks =<< splitDeck s++-- | Dovetail shuffle a deck (generalized), i.e. split the deck into /n/ parts+-- and riffle them back together.+generalizedDovetail :: Int -> Seq a -> RVar (Seq a)+generalizedDovetail n s = generalizedRiffleDecks =<< generalizedSplitDeck n s++-- | Dovetail shuffle a deck repeatedly for /n/ times.+dovetails :: Int -> Seq a -> RVar (Seq a)+dovetails n s | n > 0     = dovetail =<< dovetails (n - 1) s+              | otherwise = return s++-- | Dovetail shuffle a deck repeatedly for /shuffles/ times, +-- using /parts/ parts.+-- +-- /Invocation:/ @generalizedDovetails shuffles parts deck@+generalizedDovetails :: Int -> Int -> Seq a -> RVar (Seq a)+generalizedDovetails shuffles parts s | shuffles > 0 = step =<< next+                                      | otherwise    = return s+    where next = generalizedDovetails (shuffles - 1) parts s+          step = generalizedDovetail parts++-- | Perform an inverse dovetail shuffle, i.e. letting the cards from +-- a deck drop randomly into two heaps and then stack these heaps.+inverseDovetail :: Seq a -> RVar (Seq a)+inverseDovetail s = uncurry (><) <$> inverseRiffleDecks s++-- | Performan a generalized inverse dovetail shuffle, i.e. letting the cards+-- from a deck drop randomly into /n/ heaps and then stack them back together.+generalizedInverseDovetail :: Int -> Seq a -> RVar (Seq a)+generalizedInverseDovetail n s | null s    = return empty+                               | otherwise = foldr1 (><) <$> generalizedInverseRiffleDecks n s

@@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}  {- |-Module       : Control.Monad.Random.Extras+Module       : Data.Random.Extras Copyright    : 2010 Aristid Breitkreuz License      : BSD3 Stability    : experimental

@@ -0,0 +1,6 @@+Random-extras 0.15+------------------++This package contains additional monadic functions for random values.++It is licensed under BSD3 (see LICENSE).

@@ -1,67 +1,33 @@--- random-extras.cabal auto-generated by cabal init. For additional--- options, see--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.--- The name of the package. Name:                random-extras --- The package version. See the Haskell package versioning policy--- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for--- standards guiding when and how versions should be incremented.-Version:             0.11---- A short (one-line) description of the package.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+Version:             0.15 Synopsis:            Additional functions for random values.---- A longer description of the package. Description:         Additional functions for random values, based on random-fu. Inspired by random-shuffle.---- URL for the project homepage or repository. Homepage:            http://github.com/aristidb/random-extras---- The license under which the package is released. License:             BSD3---- The file containing the license text. License-file:        LICENSE---- The package author(s). Author:              Aristid Breitkreuz---- An email address to which users can send suggestions, bug reports,--- and patches. Maintainer:          aristidb@googlemail.com---- A copyright notice.--- Copyright:           -+Copyright:           (c) 2010 Aristid Breitkreuz Category:            Data, Math- Build-type:          Simple---- Extra files to be distributed with the package, such as examples or--- a README.--- Extra-source-files:  ---- Constraint on the version of Cabal needed to build this package.+Extra-source-files:  README Cabal-version:       >=1.8 - Library-  -- Modules exported by the library.   Exposed-modules:+        Data.Random.Dovetail,         Data.Random.Extras   -  -- Packages needed in order to build this package.   Build-depends:         base >=4 && <5,         containers ==0.3.*,         array ==0.3.*,         random-fu ==0.1.*   -  -- Modules not exported by this package.   -- Other-modules:          -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.   -- Build-tools:               GHC-Options: -Wall