Commits

Aleksey Khudyakov  committed 032f55b

Now this is fix

  • Participants
  • Parent commits c2cf05e

Comments (0)

Files changed (1)

File System/Random/MWC/CondensedTable.hs

 -- 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)
                     => 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
                 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