# HG changeset patch
# User Alexey Khudyakov
# Date 1340987130 -14400
# Node ID c2cf05ef06a64f741e8d23813798ef46f803f793
# Parent e46cbf67e57609cdbfa2e6b9a4cd5e35d5a2196b
Fix looping in tableFromProbabilities
It's possible to construct probability array which will
send `correctWeights` into infinite loop by adding element which
have probability of 1:
> tableFromProbabilities $ U.fromList [(0,1),(1::Int,0)]
Fixes #17
diff --git a/System/Random/MWC/CondensedTable.hs b/System/Random/MWC/CondensedTable.hs
--- a/System/Random/MWC/CondensedTable.hs
+++ b/System/Random/MWC/CondensedTable.hs
@@ -106,10 +106,11 @@
=> v (a, Double) -> CondensedTable v a
{-# INLINE tableFromProbabilities #-}
tableFromProbabilities v
- | G.null v = pkgError "tableFromProbabilities" "empty vector of outcomes"
- | otherwise = tableFromIntWeights $ G.map (second $ round . (* mlt)) v
+ | G.null tbl = pkgError "tableFromProbabilities" "empty vector of outcomes"
+ | otherwise = tableFromIntWeights $ G.map (second $ round . (* mlt)) tbl
where
- mlt = 4.294967296e9 -- 2^32
+ mlt = 4.294967296e9 -- 2^32
+ tbl = G.filter ((> 0) . snd) v -- Drop non-positive probabilities
-- | Same as 'tableFromProbabilities' but treats number as weights not
-- probilities. Non-positive weights are discarded, and those
@@ -131,7 +132,7 @@
-- | Generate a condensed lookup table from integer weights. Weights
-- should sum to @2^32@. If they don't, the algorithm will alter the
-- weights so that they do. This approach should work reasonably well
--- for rounding error.
+-- for rounding errors.
tableFromIntWeights :: (Vector v (a,Word32), Vector v a, Vector v Word32)
=> v (a, Word32)
-> CondensedTable v a