random-extras 0.16 → 0.17

raw patch · 4 files changed

+91/−12 lines, 4 files

Files

Data/Random/Distribution/Uniform/Exclusive.hs +71/−0
Data/Random/Shuffle/Weighted.hs +17/−10
README +1/−1
random-extras.cabal +2/−1

+ Data/Random/Distribution/Uniform/Exclusive.hs view

@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleContexts #-}++{- |+Module       : Data.Random.Extras+Copyright    : 2010 Aristid Breitkreuz+License      : BSD3+Stability    : experimental+Portability  : portable++An uniform distribution that excludes the first parameter.+-}++module Data.Random.Distribution.Uniform.Exclusive+(+  Excludable(..)+, uniformExclusiveDist+, uniformExclusive+)+where+  +import Data.Random.RVar+import Data.Random.Distribution+import Data.Random.Distribution.Uniform+import Data.Random.Internal.Fixed+import Data.Int+import Data.Word+import Data.Fixed++-- | A class for excluding discrete values. No change for floating point+-- values.+-- +-- /Note:/ 'Uniform' is exclusive on the second argument for floating point+--         values, so 'Excludable' does not need to exclude anything for them.+class Excludable a where+    smaller :: a -> a+    bigger :: a -> a++-- | A uniform distribution that excludes the first parameter+-- , but includes the second.+-- +-- /Note:/ 'Uniform' behaves the opposite way for floating point values.+uniformExclusiveDist :: (Excludable a, Ord a) => a -> a -> Uniform a+uniformExclusiveDist a b | c == EQ   = error "Invalid exclusive uniform distribution"+                         | c == LT   = Uniform b (bigger a)+                         | otherwise = Uniform (smaller a) b+    where c = compare a b++-- | A uniformly distributed random value that excludes the first parameter.+uniformExclusive :: (Distribution Uniform a, Excludable a, Ord a) => a -> a -> RVar a+uniformExclusive a b = rvar $ uniformExclusiveDist a b++instance Excludable Int where { smaller = pred; bigger = succ }+instance Excludable Int8 where { smaller = pred; bigger = succ }+instance Excludable Int16 where { smaller = pred; bigger = succ }+instance Excludable Int32 where { smaller = pred; bigger = succ }+instance Excludable Int64 where { smaller = pred; bigger = succ }+instance Excludable Word where { smaller = pred; bigger = succ }+instance Excludable Word8 where { smaller = pred; bigger = succ }+instance Excludable Word16 where { smaller = pred; bigger = succ }+instance Excludable Word32 where { smaller = pred; bigger = succ }+instance Excludable Word64 where { smaller = pred; bigger = succ }+instance Excludable Integer where { smaller = pred; bigger = succ }++instance Excludable Float where { smaller = id; bigger = id }+instance Excludable Double where { smaller = id; bigger = id }++instance Excludable Bool where { smaller = not; bigger = not }++instance HasResolution r => Excludable (Fixed r) where+    smaller = mkFixed . pred . unMkFixed+    bigger = mkFixed . succ . unMkFixed

Data/Random/Shuffle/Weighted.hs view

@@ -50,37 +50,42 @@ import Data.Random.RVar import Data.Random.Distribution import Data.Random.Distribution.Uniform+import Data.Random.Distribution.Uniform.Exclusive 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 :: (Num w, Ord w, Distribution Uniform w, Excludable 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 :: (Num w, Ord w, Distribution Uniform w, Excludable 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 :: (Num w, Ord w, Distribution Uniform w, Excludable 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 :: (Num w, Ord w, Distribution Uniform w, Excludable 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+weightedChoiceExtractCDF :: (Num w, Ord w, Distribution Uniform w, Excludable w) => M.Map w a -> RVar (M.Map w a, a)+weightedChoiceExtractCDF m | M.null m         = moduleError "weightedChoiceExtractCDF" "empty map"+                           | M.null exceptMax = return (exceptMax, maxE)+                           | otherwise        = extract <$> uniformExclusive 0 wmax+    where Just ((wmax, maxE), exceptMax) = M.maxViewWithKey m           extract w = (a `M.union` M.mapKeysMonotonic (subtract gap) c, b)-              where (a, r) = M.split w m+              where (a, e, r') = M.splitLookup w m+                    r = case e of+                          Nothing -> r'+                          Just ex -> M.insert w ex r'                     Just ((k, b), c) = M.minViewWithKey r                     gap = case M.minViewWithKey c of                             Nothing -> 0@@ -88,4 +93,6 @@  -- | 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))+cdfMapFromList = M.fromAscListWith (const id) +                 . scanl1 (\(w1, _) (w2, x) -> (w1 + w2, x)) +                 . dropWhile ((==0) . fst)

README view

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

random-extras.cabal view

@@ -1,7 +1,7 @@ Name:                random-extras  -- http://www.haskell.org/haskellwiki/Package_versioning_policy-Version:             0.16+Version:             0.17 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@@ -17,6 +17,7 @@  Library   Exposed-modules:+        Data.Random.Distribution.Uniform.Exclusive,         Data.Random.Dovetail,         Data.Random.Extras,         Data.Random.Shuffle.Weighted