numhask-histogram (empty) → 0.0.0.1

raw patch · 6 files changed

+236/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, containers, doctest, foldl, numhask, numhask-range, protolude, tasty, tasty-hunit, tasty-quickcheck, tdigest

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• numhask-histogram.cabal +60/−0
• src/NumHask/Histogram.hs +118/−0
• stack.yaml +7/−0
• test/test.hs +19/−0

@@ -0,0 +1,30 @@+Copyright Tony Day (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tony Day nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack++name:           numhask-histogram+version:        0.0.0.1+synopsis:       See readme.md+description:    See readme.md for description.+category:       project+homepage:       https://github.com/tonyday567/numhask-histogram#readme+bug-reports:    https://github.com/tonyday567/numhask-histogram/issues+author:         Tony Day+maintainer:     tonyday567@gmail.com+copyright:      Tony Day (c) 2017+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    stack.yaml++source-repository head+  type: git+  location: https://github.com/tonyday567/numhask-histogram++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , protolude+    , containers+    , foldl+    , numhask+    , numhask-range+    , tdigest+  exposed-modules:+      NumHask.Histogram+  other-modules:+      Paths_numhask_histogram+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: test.hs+  hs-source-dirs:+      test+  build-depends:+      base >=4.7 && <5+    , protolude+    , HUnit+    , QuickCheck+    , doctest+    , protolude+    , tasty+    , tasty-hunit+    , tasty-quickcheck+  default-language: Haskell2010

@@ -0,0 +1,118 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++module NumHask.Histogram+  ( Histogram(..)+  , DealOvers(..)+  , fill+  , regular+  , makeRects+  , regularQuantiles+  , quantileFold+  , fromQuantiles+  , freq+  ) where++import Data.TDigest+import NumHask.Prelude+import NumHask.Range+import NumHask.Rect+import NumHask.Space+import qualified Data.Map as Map+import qualified Control.Foldl as L+import qualified Data.List++-- | a Histogram is a list of contiguous boundaries (a boundary being the lower edge of one bucket and the upper edge of another), and a count for each bucket+-- Overs and Unders are counted in key=0 and key=length cut+data Histogram = Histogram+   { cuts   :: [Double] -- bucket boundaries+   , values :: Map.Map Int Double -- bucket counts+   } deriving (Show, Eq)++-- | whether or not to ignore unders and overs+data DealOvers = IgnoreOvers | IncludeOvers Double++-- | fill a Histogram using pre-specified cuts+-- >>> fill [0,50,100] [1..100]+-- Histogram {cuts = [0.0,50.0,100.0], values = fromList [(1,50.0),(2,50.0)]}+fill :: (Functor f, Foldable f) => [Double] -> f Double -> Histogram+fill cs xs = Histogram cs (histMap cs xs)+  where+    histMap cs' xs' = L.fold count $+        (\x -> L.fold countBool (fmap (x >) cs')) <$> xs'+    count = L.premap (\x -> (x,1.0)) countW+    countBool = L.Fold (\x a -> x + if a then 1 else 0) 0 identity+    countW = L.Fold (\x (a,w) -> Map.insertWith (+) a w x) Map.empty identity++-- | make a histogram using n equally spaced cuts over the entire range of the data+-- >>> regular 4 [0..100]+-- Histogram {cuts = [0.0,25.0,50.0,75.0,100.0], values = fromList [(0,1.0),(1,25.0),(2,25.0),(3,25.0),(4,25.0)]}+--+regular :: Int -> [Double] -> Histogram+regular n xs = fill cs xs+  where+    cs = grid OuterPos (space xs :: Range Double) n++-- | transform a Histogram to Rects+-- >>> makeRects IgnoreOvers (regular 4 [0..100])+-- [Rect 0.0 25.0 0.0 0.25,Rect 25.0 50.0 0.0 0.25,Rect 50.0 75.0 0.0 0.25,Rect 75.0 100.0 0.0 0.25]+--+makeRects :: DealOvers -> Histogram -> [Rect Double]+makeRects o (Histogram cs counts) = Data.List.zipWith4 Rect x z y w'+  where+    y = repeat 0+    w = zipWith (/)+        ((\x' -> Map.findWithDefault 0 x' counts) <$> [f..l])+        (zipWith (-) z x)+    f = case o of+          IgnoreOvers -> 1+          IncludeOvers _ -> 0+    l = case o of+          IgnoreOvers -> length cs - 1+          IncludeOvers _ -> length cs+    w' = (/sum w) <$> w+    x = case o of+          IgnoreOvers -> cs+          IncludeOvers outw ->+            [Data.List.head cs - outw] <>+            cs <>+            [Data.List.last cs + outw]+    z = drop 1 x+++-- | approx regular n-quantiles+-- >>> regularQuantiles 4 [0..100]+-- [0.0,24.75,50.0,75.25,100.0]+--+regularQuantiles :: Double -> [Double] -> [Double]+regularQuantiles n = L.fold (quantileFold qs)+  where+    qs = ((1 / n) *) <$> [0 .. n]++-- | one-pass approximate quantiles fold+quantileFold :: [Double] -> L.Fold Double [Double]+quantileFold qs = L.Fold step begin done+  where+    step x a = Data.TDigest.insert a x+    begin = tdigest ([] :: [Double]) :: TDigest 25+    done x = fromMaybe nan . (`quantile` compress x) <$> qs++-- | take a specification of quantiles and make a Histogram+-- >>> fromQuantiles [0,0.25,0.5,0.75,1] (regularQuantiles 4 [0..100])+-- Histogram {cuts = [0.0,24.75,50.0,75.25,100.0], values = fromList [(1,0.25),(2,0.25),(3,0.25),(4,0.25)]}+--+fromQuantiles :: [Double] -> [Double] -> Histogram+fromQuantiles qs xs = Histogram xs (Map.fromList $ zip [1..] (diffq qs))+  where+    diffq [] = []+    diffq [_] = []+    diffq (x:xs') = L.fold (L.Fold step (x,[]) (reverse . snd)) xs'+    step (a0,xs') a = (a,(a-a0):xs')++-- | normalize a histogram so that sum values = one+-- >>> freq $ fill [0,50,100] [1..100]+-- Histogram {cuts = [0.0,50.0,100.0], values = fromList [(1,0.5),(2,0.5)]}+--+freq :: Histogram -> Histogram+freq (Histogram cs vs) = Histogram cs $ Map.map (* recip (sum vs)) vs

@@ -0,0 +1,7 @@+resolver: nightly-2017-12-29++packages:+- .++extra-deps: []+

@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++module Main where++import Protolude+import Test.Tasty (TestTree, testGroup, defaultMain)+import Test.DocTest++main :: IO ()+main = do+    doctest ["src/NumHask/Histogram.hs"]+    defaultMain tests++tests :: TestTree+tests =+    testGroup ""+    [+    ]