fix(runtime): fix a precondition in histogram and improve docs and tests

src/runtime-prototype/src/StuntDouble/Histogram.hs

@@ -10,8 +10,10 @@
 -- Portability :  non-portable (GHC extensions)
 --
 -- This module is a Haskell port of Tyler Neely's historian Rust
--- [crate](https://github.com/spacejam/historian) which is licensed under the
--- [Apache license version 2.0](https://www.apache.org/licenses/LICENSE-2.0).
+-- [crate](https://github.com/spacejam/historian), which in turn seems to be
+-- derived from his [loghisto](https://github.com/spacejam/loghisto) Golang
+-- library. Neely's code bases both use the [Apache license version
+-- 2.0](https://www.apache.org/licenses/LICENSE-2.0).
 --
 -----------------------------------------------------------------------------
 module StuntDouble.Histogram where
@@ -43,7 +45,8 @@ newHistogram = Histogram
   <*> newCounter 0
   <*> newCounter 0
 
--- | The value @v@ must be positive.
+-- | The value @v@ must be positive. For values larger or equal to @1@ the
+-- compression loss is less than @1%@.
 measure :: RealFrac a => a -> Histogram -> IO Int
 measure v h = do
   incrCounter_ (round v) (histoSum h)
@@ -66,7 +69,7 @@ decompress w = exp (realToFrac w / precision) - 1
 
 percentile :: Double -> Histogram -> IO (Maybe Double)
 percentile p h
-  | p <= 100.0 = error "percentile: percentiles cannot be over 100"
+  | p > 100.0 = error "percentile: percentiles cannot be over 100"
   | otherwise  = do
       count <- readCounter (histoCount h)
       if count == 0

src/runtime-prototype/test/StuntDouble/HistogramTest.hs

@@ -1,5 +1,6 @@
 module StuntDouble.HistogramTest where
 
+import GHC.Float
 import Control.Monad
 import Test.QuickCheck
 import Test.HUnit
@@ -8,14 +9,31 @@ import StuntDouble.Histogram
 
 ------------------------------------------------------------------------
 
-prop_roundtrip :: Double -> Bool
-prop_roundtrip d =
-  let
+prop_roundtrip :: Positive Double -> Property
+prop_roundtrip (Positive d) = withMaxSuccess 100000 $
+  d >= 1 ==>
+  classify (1    <= d && d < 10)   "1-9" $
+  classify (10   <= d && d < 100)  "10-99" $
+  classify (100  <= d && d < 1000) "100-999" $
+  classify (1000 <= d)             "1000-.." $
+  d * 0.99 <= d' && d' <= d * 1.01
+  where
+    d' = decompress (compress d)
+
+prop_roundtripLarge :: Large Int -> Property
+prop_roundtripLarge (Large i) = withMaxSuccess 100000 $
+  d >= 1 ==>
+  classify (1     <= d && d < 10)       "1-9" $
+  classify (10    <= d && d < 100)      "10-99" $
+  classify (100   <= d && d < 1000)     "100-999" $
+  classify (1000  <= d && d < 10000)    "1000-9999" $
+  classify (10000 <= d && d < 100000)   "10000-99999" $
+  classify (100000 <= d && d < 1000000) "100000-999999" $
+  classify (1000000 <= d)               "1000000-.." $
+  d * 0.99 <= d' && d' <= d * 1.01
+  where
+    d  = int2Double (abs i)
     d' = decompress (compress d)
-    ad = abs d
-  in
-    if ad <= 0.25 then True else
-    ad * 0.97 <= d' && d' <= ad * 1.03
 
 assertIO :: (Eq a, Show a) => IO a -> a -> Assertion
 assertIO io y = do