# HG changeset patch # User Alexey Khudyakov # Date 1340989684 -14400 # Node ID 032f55bd8c7ca10fb544aaa422e739894b315e85 # Parent c2cf05ef06a64f741e8d23813798ef46f803f793 Now this is fix 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 @@ -102,21 +102,29 @@ -- the case, this algorithm will construct a table for some -- distribution that may bear no resemblance to what you intended. tableFromProbabilities - :: (Vector v (a,Word32), Vector v (a,Double), Vector v a, Vector v Word32) + :: (Vector v (a,Word32), Vector v (a,Double), Vector v a, Vector v Word32, Show a) => v (a, Double) -> CondensedTable v a {-# INLINE tableFromProbabilities #-} tableFromProbabilities v | G.null tbl = pkgError "tableFromProbabilities" "empty vector of outcomes" - | otherwise = tableFromIntWeights \$ G.map (second \$ round . (* mlt)) tbl + | otherwise = tableFromIntWeights \$ G.map (second \$ toWeight . (* mlt)) tbl where - mlt = 4.294967296e9 -- 2^32 - tbl = G.filter ((> 0) . snd) v -- Drop non-positive probabilities + -- 2^32. N.B. This number is exatly representable. + mlt = 4.294967296e9 + -- Drop non-positive probabilities + tbl = G.filter ((> 0) . snd) v + -- Convert Double weight to Word32 and avoid overflow at the same + -- time. It's especially dangerous if one probability is + -- approximately 1 and others are 0. + toWeight w | w > mlt - 1 = 2^(32::Int) - 1 + | otherwise = round w + -- | Same as 'tableFromProbabilities' but treats number as weights not -- probilities. Non-positive weights are discarded, and those -- remaining are normalized to 1. tableFromWeights - :: (Vector v (a,Word32), Vector v (a,Double), Vector v a, Vector v Word32) + :: (Vector v (a,Word32), Vector v (a,Double), Vector v a, Vector v Word32, Show a) => v (a, Double) -> CondensedTable v a {-# INLINE tableFromWeights #-} tableFromWeights = tableFromProbabilities . normalize . G.filter ((> 0) . snd) @@ -137,7 +145,7 @@ => v (a, Word32) -> CondensedTable v a {-# INLINE tableFromIntWeights #-} -tableFromIntWeights tbl +tableFromIntWeights v | n == 0 = pkgError "tableFromIntWeights" "empty table" -- Single element tables should be treated sepately. Otherwise -- they will confuse correctWeights @@ -153,6 +161,9 @@ nc cc dd where + -- We must filter out zero-probability outcomes because they may + -- confuse weight correction algorithm + tbl = G.filter ((/=0) . snd) v n = G.length tbl -- Corrected table table = uncurry G.zip \$ id *** correctWeights \$ G.unzip tbl