random-extras 0.15 → 0.16

raw patch · 5 files changed

+111/−9 lines, 5 files

Files

• Data/Random/Dovetail.hs +9/−2
• Data/Random/Extras.hs +7/−4
• Data/Random/Shuffle/Weighted.hs +91/−0
• README +1/−1
• random-extras.cabal +3/−2

@@ -34,6 +34,8 @@   -- ** Inverse dovetail shuffling , inverseDovetail , generalizedInverseDovetail+  -- * Face up, face down shuffling+, faceUpFaceDown ) where   @@ -44,7 +46,7 @@ import Data.Random.Distribution.Uniform import Data.Foldable (foldr1) import Data.Sequence hiding (replicateM)-import Prelude hiding (null, length, splitAt, replicate, foldr1)+import Prelude hiding (null, length, splitAt, replicate, foldr1, reverse)  -- | Split a deck into two /roughly equal/ halves. splitDeck :: Seq a -> RVar (Seq a, Seq a)@@ -127,8 +129,13 @@ inverseDovetail :: Seq a -> RVar (Seq a) inverseDovetail s = uncurry (><) <$> inverseRiffleDecks s --- | Performan a generalized inverse dovetail shuffle, i.e. letting the cards+-- | Perform 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++-- | Perform a /face up, face down/ shuffle, which is like a dovetail shuffle+-- where the lower of the two halves is reversed.+faceUpFaceDown :: Seq a -> RVar (Seq a)+faceUpFaceDown s = uncurry (riffleDecks . reverse) =<< splitDeck s

@@ -47,6 +47,9 @@ import qualified Data.Array import Data.Array.IArray ((!)) +moduleError :: String -> String -> a+moduleError n s = error $ "Data.Random.Extras." ++ n ++ ": " ++ s+ (.:) :: (c -> c') -> (a -> b -> c) -> (a -> b -> c') (.:) = (.).(.) @@ -128,7 +131,7 @@ --  -- /Complexity:/ O(n), where /n/ is the length of the input list. choice :: [a] -> RVar a-choice [] = error "Control.Monad.Random.Extras.choice: empty list"+choice [] = moduleError "choice" "empty list" choice xs = (xs !!) `liftM` uniform 0 (length xs - 1)  -- | Safely select a random element from a list.@@ -153,7 +156,7 @@                     | otherwise = old             return $! new `seq` (new, n + 1)           start = (err, 0 :: Int)-          err = error "Control.Monad.Random.Extras.iterativeChoice: empty list"+          err = moduleError "iterativeChoice" "empty list"  -- | Select a random element from a sequence. -- @@ -161,7 +164,7 @@ --  -- /Complexity:/ O(log n), where /n/ is the length of the input sequence. choiceSeq :: Seq.Seq a -> RVar a-choiceSeq s | Seq.null s = error "Control.Monad.Random.Extras.choiceSeq: empty sequence"+choiceSeq s | Seq.null s = moduleError "choiceSeq" "empty sequence"             | otherwise  = Seq.index s `liftM` uniform 0 (Seq.length s - 1)                             -- | Safely select a random element from a sequence.@@ -185,7 +188,7 @@ --  -- /Complexity:/ O(n) base and O(1) per element. choices :: Int -> [a] -> RVar [a]-choices _ [] = error "Control.Monad.Random.Extras.choices: empty list"+choices _ [] = moduleError "choices" "empty list" choices n xs = choicesArray n $ Data.Array.listArray (1, length xs) xs  -- | Safely get a stream of random elements from a list.

@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleContexts #-}++{- |+Module       : Data.Random.Extras+Copyright    : 2010 Aristid Breitkreuz+License      : BSD3+Stability    : experimental+Portability  : portable++Functions for shuffling elements according to weights.++Definitions:++  [Weight]        A number above /0/ denoting how likely it is for an element to +                  end up in the first position.++  [Probability]   A weight normalised into the /(0,1]/ range.++  [Weighted list] A list of pairs @(w, a)@, where @w@ is the weight of +                  element @a@.+                  The probability of an element getting into the first position+                  is equal by its weight divided by the sum of all weights, and+                  the probability of getting into a position other than the +                  first is equal to the probability of getting in the first +                  position when all elements in prior positions have been+                  removed from the weighted list.++  [CDF Map]       A map of /summed weights/ to elements. For example, a weighted+                  list @[(0.2, 'a'), (0.6, 'b'), (0.2, 'c')]@ corresponds to a+                  CDF map of @[(0.2, 'a'), (0.8, 'b'), (1.0, 'c')]@ +                  (as a 'Map'). The weights are summed from left to right.+-}++module Data.Random.Shuffle.Weighted+(+  -- * Shuffling+  weightedShuffleCDF+, weightedShuffle+  -- * Sampling+, weightedSampleCDF+, weightedSample+  -- * Extraction+, weightedChoiceExtractCDF+  -- * Utilities+, cdfMapFromList+)+where+  +import Control.Applicative ((<$>))+import Data.Random.RVar+import Data.Random.Distribution+import Data.Random.Distribution.Uniform+import qualified Data.Map as M++moduleError :: String -> String -> a+moduleError n s = error $ "Data.Random.Shuffle.Weighted." ++ n ++ ": " ++ s++-- | Randomly shuffle a CDF map according to its weights.+weightedShuffleCDF :: (Num w, Ord w, Distribution Uniform w) => M.Map w a -> RVar [a]+weightedShuffleCDF m | M.null m  = return []+                     | otherwise = weightedChoiceExtractCDF m >>= \(m', a) -> (a:) <$> weightedShuffleCDF m'++-- | Randomly shuffle a weighted list according to its weights.+weightedShuffle :: (Num w, Ord w, Distribution Uniform w) => [(w, a)] -> RVar [a]+weightedShuffle = weightedShuffleCDF . cdfMapFromList++-- | Randomly draw /n/ elements from a CDF map according to its weights.+weightedSampleCDF :: (Num w, Ord w, Distribution Uniform w) => Int -> M.Map w a -> RVar [a]+weightedSampleCDF n m | M.null m || n <= 0 = return []+                      | otherwise          = weightedChoiceExtractCDF m >>= \(m', a) -> (a:) <$> weightedSampleCDF (n - 1) m'++-- | Randomly draw /n/ elements from a weighted list according to its weights.+weightedSample :: (Num w, Ord w, Distribution Uniform w) => Int -> [(w, a)] -> RVar [a]+weightedSample n = weightedSampleCDF n . cdfMapFromList++-- | Randomly extract an element from a CDF map according to its weights. The+-- element is removed and the resulting "weight gap" closed.+weightedChoiceExtractCDF :: (Num w, Ord w, Distribution Uniform w) => M.Map w a -> RVar (M.Map w a, a)+weightedChoiceExtractCDF m | M.null m  = moduleError "weightedChoiceExtractCDF" "empty map"+                           | otherwise = extract <$> uniform 0 wmax+    where Just ((wmax, _), _) = M.maxViewWithKey m+          extract w = (a `M.union` M.mapKeysMonotonic (subtract gap) c, b)+              where (a, r) = M.split w m+                    Just ((k, b), c) = M.minViewWithKey r+                    gap = case M.minViewWithKey c of+                            Nothing -> 0+                            Just ((k2, _), _) -> k2 - k++-- | Generate a CDF map from a weighted list.+cdfMapFromList :: Num w => [(w, a)] -> M.Map w a+cdfMapFromList = M.fromAscList . scanl1 (\(w1, _) (w2, x) -> (w1 + w2, x))

@@ -1,4 +1,4 @@-Random-extras 0.15+Random-extras 0.16 ------------------  This package contains additional monadic functions for random values.

@@ -1,7 +1,7 @@ Name:                random-extras  -- http://www.haskell.org/haskellwiki/Package_versioning_policy-Version:             0.15+Version:             0.16 Synopsis:            Additional functions for random values. Description:         Additional functions for random values, based on random-fu. Inspired by random-shuffle. Homepage:            http://github.com/aristidb/random-extras@@ -18,7 +18,8 @@ Library   Exposed-modules:         Data.Random.Dovetail,-        Data.Random.Extras+        Data.Random.Extras,+        Data.Random.Shuffle.Weighted      Build-depends:         base >=4 && <5,