diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +# 0.1.5.0 +- Added `histogram`, `histogram'` and `ordersOfMagnitude`. + # 0.1.4.6 - Relax bounds on tasty-quickcheck diff --git a/foldl-statistics.cabal b/foldl-statistics.cabal --- a/foldl-statistics.cabal +++ b/foldl-statistics.cabal @@ -1,82 +1,74 @@ -name: foldl-statistics -version: 0.1.4.6 -cabal-version: >=1.10 -build-type: Simple -license: BSD3 -license-file: LICENSE -copyright: 2016 Data61 (CSIRO) -maintainer: Alex.Mason@data61.csiro.au -homepage: http://github.com/Data61/foldl-statistics#readme -synopsis: Statistical functions from the statistics package implemented as - Folds. -description: - The use of this package allows statistics to be computed using at most two - passes over the input data, one to compute a mean and one to compute a further - statistic such as variance and /n/th central moments. All algorithms are the - obvious implementation of Bryan O\'Sullivan\'s - package imeplemented - as `Fold's from the - package. -category: Math, Statistics -author: Alex Mason -extra-source-files: - CHANGELOG.md - README.md - -source-repository head - type: git - location: https://github.com/Data61/foldl-statistics +name: foldl-statistics +version: 0.1.5.0 +synopsis: Statistical functions from the statistics package implemented as + Folds. +description: The use of this package allows statistics to be computed using at most two + passes over the input data, one to compute a mean and one to compute a further + statistic such as variance and /n/th central moments. All algorithms are the + obvious implementation of Bryan O\'Sullivan\'s + package imeplemented + as `Fold's from the + package. +homepage: http://github.com/Data61/foldl-statistics#readme +license: BSD3 +license-file: LICENSE +author: Alex Mason +maintainer: Alex.Mason@data61.csiro.au +copyright: 2016 Data61 (CSIRO) +category: Math, Statistics +build-type: Simple +extra-source-files: CHANGELOG.md, README.md +cabal-version: >=1.10 +tested-with: GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.* library - - if impl(ghc <8.0) - build-depends: - semigroups >=0.18 && <1.0 - exposed-modules: - Control.Foldl.Statistics - build-depends: - base >=4.7 && <5, - foldl >=1.1 && <1.4, - math-functions >=0.1 && <0.3, - profunctors ==5.2.* - default-language: Haskell2010 - hs-source-dirs: src + hs-source-dirs: src + exposed-modules: Control.Foldl.Statistics + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , foldl >= 1.1 && < 1.4 + , math-functions >= 0.1 && < 0.3 + , profunctors >= 5.2 && < 5.3 + , containers >= 0.1.0.0 && < 0.6 + , unordered-containers >= 0.1.0.0 && < 0.3 + , hashable >=1.0.1.1 && < 1.3 + if impl(ghc < 8.0) + build-depends: semigroups >= 0.18 && < 1.0 + test-suite foldl-statistics-test - - if impl(ghc <8.0) - build-depends: - semigroups >=0.18.2 && <0.19 - type: exitcode-stdio-1.0 - main-is: Spec.hs - build-depends: - base >=4.7 && <5.0, - foldl-statistics >=0.1.4.6 && <0.2, - foldl >=1.2.5 && <1.3, - statistics >=0.13 && <0.15, - tasty ==0.11.*, - tasty-quickcheck >=0.8 && <0.10, - vector >=0.11 && <0.13, - quickcheck-instances ==0.3.*, - profunctors ==5.2.* - default-language: Haskell2010 - hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + build-depends: base + , foldl-statistics + , foldl + , statistics >= 0.13 && < 0.15 + , tasty >= 0.11 && < 0.12 + , tasty-quickcheck >= 0.8 && < 0.10 + , vector >= 0.11 && < 0.13 + , quickcheck-instances >= 0.3 && < 0.4 + , profunctors + if impl(ghc < 8.0) + build-depends: semigroups -benchmark bench-folds - - if impl(ghc <8.0) - build-depends: - semigroups >=0.18.2 && <0.19 - type: exitcode-stdio-1.0 - main-is: Main.hs - build-depends: - base >=4.9.1.0 && <4.10, - foldl-statistics >=0.1.4.6 && <0.2, - criterion ==1.1.*, - vector >=0.10 && <1.0, - statistics >=0.13.3.0 && <0.14, - mwc-random ==0.13.*, - foldl >=1.2.5 && <1.3 - default-language: Haskell2010 - hs-source-dirs: bench +Benchmark bench-folds + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + default-language: Haskell2010 + build-depends: base + , foldl-statistics + , foldl + , statistics >= 0.13 && < 0.15 + , criterion >= 1.1 && < 1.3 + , vector >= 0.10 && < 1.0 + , mwc-random >= 0.13 && < 0.14 + if impl(ghc < 8.0) + build-depends: semigroups + +source-repository head + type: git + location: https://github.com/Data61/foldl-statistics diff --git a/src/Control/Foldl/Statistics.hs b/src/Control/Foldl/Statistics.hs --- a/src/Control/Foldl/Statistics.hs +++ b/src/Control/Foldl/Statistics.hs @@ -1,10 +1,11 @@ {-# LANGUAGE CPP #-} + -- | -- Module : Control.Foldl.Statistics --- Copyright : (c) 2011 Bryan O'Sullivan, 2016 National ICT Australia +-- Copyright : (c) 2011 Bryan O'Sullivan, 2016 National ICT Australia, 2018 CSIRO -- License : BSD3 -- --- Maintainer : alex.mason@nicta.com.au +-- Maintainer : Alex.Mason@data61.csiro.au -- Stability : experimental -- Portability : portable -- @@ -15,6 +16,9 @@ -- * Descriptive functions range , sum' + , histogram + , histogram' + , ordersOfMagnitude -- * Statistics of location , mean @@ -82,6 +86,10 @@ import Control.Applicative #endif +import Data.Hashable (Hashable) +import qualified Data.HashMap.Strict as Hash +import qualified Data.Map.Strict as Map + import Numeric.Sum (KBNSum, add, kbn, zero) data T = T {-# UNPACK #-}!Double {-# UNPACK #-}!Int @@ -120,6 +128,37 @@ range = (\(Just lo) (Just hi) -> hi - lo) <$> F.minimum <*> F.maximum + +-- | Create a histogram of each value of type a. Useful for folding over +-- categorical values, for example, a CSV where you have a data type for a +-- selection of categories. +-- +-- It should not be used for continuous values which would lead to a high number +-- of keys. One way to avoid this is to use the `Profunctor` instance for `Fold` +-- to break your values into categories. For an example of doing this, see +-- `ordersOfMagnitude`. +histogram :: Ord a => Fold a (Map.Map a Int) +histogram = Fold step Map.empty id where + step m a = Map.insertWith (+) a 1 m + +-- | Like `histogram`, but for use when hashmaps would be more efficient for the +-- particular type @a@. +histogram' :: (Hashable a, Eq a) => Fold a (Hash.HashMap a Int) +histogram' = Fold step Hash.empty id where + step m a = Hash.insertWith (+) a 1 m + +-- | Provides a histogram of the orders of magnitude of the values in a series. +-- Negative values are placed in the @0.0@ category due to the behaviour of +-- `logBase`. it may be useful to use @lmap abs@ on this Fold to get a histogram +-- of the absolute magnitudes. + +-- TODO: logBase 10 1000000 /= 6 but 5, fix this +ordersOfMagnitude :: Fold Double (Map.Map Double Int) +ordersOfMagnitude = + dimap + ((floor :: Double -> Int) . logBase 10) + (Map.mapKeysMonotonic (10^^)) + histogram -- | Arithmetic mean. This uses Kahan-Babuška-Neumaier -- summation, so is more accurate than 'welfordMean' unless the input diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -50,7 +50,7 @@ <*> kurtosis m precision :: Double -precision = 0.0000000001 +precision = 10e-9 cmpLMVSK :: Double -> LMVSK -> LMVSK -> Bool cmpLMVSK prec a b = let @@ -61,6 +61,16 @@ && t lmvskSkewness && ((==) `on` lmvskCount) a b +diffLMVSK :: LMVSK -> LMVSK -> LMVSK +diffLMVSK a b = LMVSK + (t lmvskCount) + (t lmvskMean) + (t lmvskVariance) + (t lmvskSkewness) + (t lmvskKurtosis) + where t f = f a - f b + + main :: IO () main = defaultMain $ testGroup "Results match Statistics.Sample" @@ -94,12 +104,14 @@ m = F.fold mean $ U.toList vec fast = F.fold fastLMVSK $ U.toList vec reference = F.fold (testLMVSK m) $ U.toList vec - in cmpLMVSK precision fast reference + in QC.counterexample (unlines ["",show fast,show reference, "Diff:", show (diffLMVSK fast reference)]) $ + cmpLMVSK precision fast reference , QC.testProperty "LMVSKSemigroup" $ \v1 v2 -> U.length v1 > 2 && U.length v2 > 2 && U.sum (mappend v1 v1) /= U.product (mappend v1 v1) ==> let sep = getLMVSK $ F.fold foldLMVSKState (U.toList v1) <> F.fold foldLMVSKState (U.toList v2) tog = F.fold fastLMVSK (U.toList v1 ++ U.toList v2) - in cmpLMVSK precision sep tog + in QC.counterexample (unlines ["",show sep,show tog, "Diff:", show (diffLMVSK sep tog)]) + $ cmpLMVSK precision sep tog || isNaN (lmvskKurtosis sep) || isNaN (lmvskKurtosis tog) ] @@ -191,4 +203,4 @@ withinPCT :: Double -> Double -> Double -> Bool -withinPCT pct a b = abs (a - b) * 100 / (min `on` abs) a b < pct +withinPCT pct a b = abs ((a - b) * 100 / (min `on` abs) a b) < pct