summaryrefslogtreecommitdiff
path: root/src/Numeric/StreamingHistogram/Internal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Numeric/StreamingHistogram/Internal.hs')
-rw-r--r--src/Numeric/StreamingHistogram/Internal.hs23
1 files changed, 23 insertions, 0 deletions
diff --git a/src/Numeric/StreamingHistogram/Internal.hs b/src/Numeric/StreamingHistogram/Internal.hs
new file mode 100644
index 0000000..e19a40b
--- /dev/null
+++ b/src/Numeric/StreamingHistogram/Internal.hs
@@ -0,0 +1,23 @@
+module Numeric.StreamingHistogram.Internal
+ ( shrink
+ ) where
+
+import qualified Data.List as L
+
+-- Internal: Lossy compression of histogram by finding the pair of
+-- values that would introduce minimum error when merged and then do a
+-- weighted merge.
+shrink :: [(Double, Int)] -> [(Double, Int)]
+shrink m
+ | length m == 0 = m
+ | otherwise = shrunk'
+ where
+ deltas = L.zipWith (\(x, _) (y, _)-> y - x) (init m) (L.tail m)
+ minDelta = L.minimum deltas
+ shrunk' = shrunk (init m) (L.tail m)
+
+ shrunk :: [(Double, Int)] -> [(Double, Int)] -> [(Double, Int)]
+ shrunk [] [] = []
+ shrunk ((lq, lk):ls) ((rq, rk):rs)
+ | rq - lq == minDelta = ((lq * (fromIntegral lk) + rq * (fromIntegral rk)) / (fromIntegral (lk + rk)), lk + rk) : rs
+ | otherwise = (lq, lk) : (shrunk ls rs)