bins (empty) → 0.1.0.0

raw patch · 6 files changed

+572/−0 lines, 6 filesdep +basedep +containersdep +finite-typelitssetup-changed

Dependencies added: base, containers, finite-typelits, ghc-typelits-knownnat, ghc-typelits-natnormalise, math-functions, profunctors, reflection, tagged, vector-sized

Files

CHANGELOG.md +9/−0
LICENSE +30/−0
README.md +48/−0
Setup.hs +2/−0
bins.cabal +48/−0
src/Data/Bin.hs +435/−0

+ CHANGELOG.md view

@@ -0,0 +1,9 @@+# Changelog++Version 0.1.0.0+---------------++*August 20, 2018*++*   Initial release+

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Justin Le (c) 2018++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 Justin Le 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.

+ README.md view

@@ -0,0 +1,48 @@+# [bins][hackage]++Bin continuous values into discrete containers in an interval, useful for+histograms.++[hackage]: https://hackage.haskell.org/package/bins++## Usage++```haskell+-- divide into 10 bins between 5 and 50, logarithmically+ghci> withBinner (logBS @10 5 50) $ \toBin -> do+        print (toBin 1)+        print (toBin 30)+        print (binIx (toBin 30))+        print (toBin 100)+```++```+Bin (-inf .. 5.0)       -- 1 is outside of range+Bin [25.06 .. 31.55)    -- 30 is inside bin enclosed by 25.06 and 31.55+PElem (Finite 7)        -- 30 is in Bin #7 (indexed from 0)+Bin [50 .. -inf)        -- 100 is outside of range+```++```haskell+-- Generate a histogram based on the bins from valules in a list+ghci> xs = [1..100] :: [Double]+ghci> withBinner (logBS @10 5 50) $ \toBin -> do+         mapM_ (\(b, n) -> putStrLn (displayBinDouble 4 b ++ "\t" ++ show n))+       . M.toList+       $ binFreq toBin xs+```++```+(-inf .. 5.0000)        4+[5.0000 .. 6.2946)      2+[6.2946 .. 7.9245)      1+[7.9245 .. 9.9763)      2+[9.9763 .. 12.5594)     3+[12.5594 .. 15.8114)    3+[15.8114 .. 19.9054)    4+[19.9054 .. 25.0594)    6+[25.0594 .. 31.5479)    6+[31.5479 .. 39.7164)    8+[39.7164 .. 50.0000)    10+[50.0000 .. +inf)       51+```

+ Setup.hs view

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

+ bins.cabal view

@@ -0,0 +1,48 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: af7b58caad9e45647be51713c90572885560f4a41301b7384272bc6827c3264a++name:           bins+version:        0.1.0.0+synopsis:       Aggregate continuous values into discrete bins+description:    Please see the README on GitHub at <https://github.com/mstksg/bins#readme>+category:       Math+homepage:       https://github.com/mstksg/bins#readme+bug-reports:    https://github.com/mstksg/bins/issues+author:         Justin Le+maintainer:     justin@jle.im+copyright:      (c) Justin Le 2018+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+  type: git+  location: https://github.com/mstksg/bins++library+  exposed-modules:+      Data.Bin+  other-modules:+      Paths_bins+  hs-source-dirs:+      src+  ghc-options: -Wall -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , containers+    , finite-typelits+    , ghc-typelits-knownnat+    , ghc-typelits-natnormalise+    , math-functions+    , profunctors+    , reflection+    , tagged+    , vector-sized >=1.0+  default-language: Haskell2010

+ src/Data/Bin.hs view

@@ -0,0 +1,435 @@+{-# LANGUAGE ApplicativeDo                            #-}+{-# LANGUAGE DataKinds                                #-}+{-# LANGUAGE DeriveFunctor                            #-}+{-# LANGUAGE ExistentialQuantification                #-}+{-# LANGUAGE FlexibleContexts                         #-}+{-# LANGUAGE KindSignatures                           #-}+{-# LANGUAGE LambdaCase                               #-}+{-# LANGUAGE RankNTypes                               #-}+{-# LANGUAGE RecordWildCards                          #-}+{-# LANGUAGE ScopedTypeVariables                      #-}+{-# LANGUAGE StandaloneDeriving                       #-}+{-# LANGUAGE TypeApplications                         #-}+{-# LANGUAGE TypeOperators                            #-}+{-# LANGUAGE UndecidableInstances                     #-}+{-# LANGUAGE ViewPatterns                             #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}+{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise       #-}++-- |+-- Module      : Data.Bin+-- Copyright   : (c) Justin Le 2018+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Tools for aggregating numeric values into a set of discrete bins+-- according to some binning specification.+--+-- See 'withBinner' for main usage information, and 'Bin' for the main+-- binned data type, and 'binFreq' for a common usage example.+--++module Data.Bin (+  -- * Specifying the binning+    BinView, linView, logView, gaussView+  , BinSpec(..), linBS, logBS, gaussBS+  , binSpecIntervals+  -- * Creating and manipulating bins+  , Bin, Binner, withBinner, fromFin+  -- ** Inspecting bins+  , binFin, binRange, binMin, binMax+  -- ** Showing bins+  , displayBin, displayBinDouble+  -- *** In-depth inspection+  , Pointed(..), pElem, binIx, fromIx+  -- * Untyped+  , SomeBin(..), sameBinSpec+  -- * Handy use patterns+  , binFreq+  ) where++import           Control.Monad+import           Data.Finite+import           Data.Foldable+import           Data.Profunctor+import           Data.Proxy+import           Data.Reflection+import           Data.Tagged+import           Data.Type.Equality+import           GHC.TypeNats+import           Numeric.SpecFunctions+import           Text.Printf+import           Unsafe.Coerce+import qualified Data.Map              as M+import qualified Data.Vector.Sized     as SV++-- | A bidirectional "view" to transform the data type before binning.+--+-- See 'linView' for a linear binning, and 'logView' for a logarithmic+-- binning.+--+-- This type is essentially 'Iso' from the /lens/ library, and any 'Iso''+-- from lens can be used here.  However, it is important that all of these+-- represent /monotonic/ isomorphisms.+type BinView a b = forall p. Profunctor p => p b b -> p a a++-- | Construct a 'BinView' based on "to" and "from" functions+--+-- It is important that the "to" and "from" functions be /inverses/ of each+-- other.  Furthermore, both "to" and "from" should be __monotonic__.+binView+    :: (a -> b)       -- ^ "to"+    -> (b -> a)       -- ^ "from"+    -> BinView a b+binView = dimap++-- | Linear binning+linView :: BinView a a+linView = binView id id++-- | Logarithmic binning (smaller bins at lower levels, larger bins at+-- higher levels).+logView :: Floating a => BinView a a+logView = binView log exp++-- | Binning based on a Gaussian Distribution.  Bins "by standard+-- deviation"; there are more bins the closer to the mean you get, and less+-- bins the farther away.+gaussView+    :: RealFrac a+    => a           -- ^ center / mean+    -> a           -- ^ standard deviation+    -> BinView a Double+gaussView μ σ = binView to from+  where+    to   = erf . realToFrac . (/ σ) . subtract μ+    from = (+ μ) . (* σ) . realToFrac . invErf++view :: BinView a b -> a -> b+view v = runForget (v (Forget id))++review :: BinView a b -> b -> a+review v = unTagged . v . Tagged++-- | Specification of binning.+--+-- A @'BinSpec' n a b@ will bin values of type @a@ into @n@ bins, according+-- to a scaling in type @b@.+--+-- Constructor is meant to be used with type application syntax to indicate+-- @n@, like @'BinSpec' @5 0 10 'linView'@+data BinSpec (n :: Nat) a b =+        BS { bsMin  :: a             -- ^ lower bound of values+           , bsMax  :: a             -- ^ upper bound of values+           , bsView :: BinView a b   -- ^ binning view+           }++-- | Convenient constructor for a 'BinSpec' for a linear scaling.+--+-- Meant to be used with type application syntax:+--+-- @+-- 'linBS' @5 0 10+-- @+linBS :: forall n a. a -> a -> BinSpec n a a+linBS mn mx = BS mn mx linView++-- | Convenient constructor for a 'BinSpec' for a logarithmic scaling.+--+-- Meant to be used with type application syntax:+--+-- @+-- 'logBS' @5 0 10+-- @+logBS :: forall n a. Floating a => a -> a -> BinSpec n a a+logBS mn mx = BS mn mx logView++-- | Convenient constructor for a 'BinSpec' for a gaussian scaling.  Uses+-- the midpoint as the inferred mean.+--+-- Meant to be used with type application syntax:+--+-- @+-- 'gaussBS' @5 0 10+-- @+gaussBS+    :: forall n a. RealFrac a+    => a+    -> a+    -> a+    -> BinSpec n a Double+gaussBS σ mn mx = BS mn mx (gaussView ((mn + mx)/2) σ)++-- | Data type extending a value with an extra "minimum" and "maximum"+-- value.+data Pointed a = Bot+               | PElem !a+               | Top+  deriving (Show, Eq, Ord, Functor)++-- | Extract the item from a 'Pointed' if it is neither the extra minimum+-- or maximum.+pElem :: Pointed a -> Maybe a+pElem = \case+    Bot     -> Nothing+    PElem x -> Just x+    Top     -> Nothing++-- | A @'Bin' s n@ is a single bin index out of @n@ partitions of the+-- original data set, according to a 'BinSpec' represented by @s@.+--+-- All 'Bin's with the same @s@ follow the same 'BinSpec', so you can+-- safely use 'binRange' 'withBinner'.+--+-- It has useful 'Eq' and 'Ord' instances.+--+-- Actually has @n + 2@ partitions, since it also distinguishes values+-- that are outside the 'BinSpec' range.+newtype Bin s n = Bin { _binIx :: Pointed (Finite n) }+  deriving (Eq, Ord)++-- | A more specific version of 'binFin' that indicates whether or not the+-- value was too high or too low for the 'BinSpec' range.+binIx :: Bin s n -> Pointed (Finite n)+binIx = _binIx++-- | Extract, potentially, the 'Bin' index.  Will return 'Nothing' if the+-- original value was outside the 'BinSpec' range.+--+-- See 'binIx' for a more specific version, which indicates if the original+-- value was too high or too low.+binFin :: Bin s n -> Maybe (Finite n)+binFin = pElem . binIx++tick+    :: forall n a b. (KnownNat n, Fractional b)+    => BinSpec n a b+    -> b+tick BS{..} = totRange / fromIntegral (natVal (Proxy @n))+  where+    totRange = view bsView bsMax - view bsView bsMin++packExtFinite+    :: KnownNat n+    => Integer+    -> Pointed (Finite n)+packExtFinite n+    | n < 0     = Bot+    | otherwise = maybe Top PElem . packFinite $ n++mkBin_+    :: forall n a b. (KnownNat n, RealFrac b)+    => BinSpec n a b+    -> a+    -> Pointed (Finite n)+mkBin_ bs = packExtFinite+          . floor+          . (/ tick bs)+          . subtract (scaleIn (bsMin bs))+          . scaleIn+  where+    scaleIn = view (bsView bs)++mkBin+    :: forall n a b s. (KnownNat n, RealFrac b, Reifies s (BinSpec n a b))+    => a+    -> Bin s n+mkBin = Bin . mkBin_ (reflect (Proxy @s))++-- | The type of a "binning function", given by 'withBinner'.  See+-- 'withBinner' for information on how to use.+type Binner s n a = a -> Bin s n++-- | With a 'BinSpec', give a "binning function" that you can use to create+-- bins within a continuation.  The binning function is meant to be used+-- with TypeApplications to specify how many bins to use:+--+-- @+-- 'withBinner' myBinSpec $ \toBin ->+--     show (toBin 2.8523)+-- @+withBinner+    :: (KnownNat n, RealFrac b)+    => BinSpec n a b+    -> (forall s. Reifies s (BinSpec n a b) => Binner s n a -> r)+    -> r+withBinner bs f = reify bs $ \(_ :: Proxy s) -> f @s mkBin++-- | Generate a vector of the boundaries deriving the bins from+-- a 'BinSpec'.  Can be useful for debugging.+binSpecIntervals+    :: forall n a b. (KnownNat n, Fractional b)+    => BinSpec n a b+    -> SV.Vector (n + 1) a+binSpecIntervals bs = SV.generate $ \i ->+    case strengthen i of+      Just (fromIntegral->i') -> scaleOut $ i' * t + scaleIn (bsMin bs)+      Nothing                 -> bsMax bs+  where+    t        = tick bs+    scaleIn  = view (bsView bs)+    scaleOut = review (bsView bs)++binRange_+    :: forall n a b. (KnownNat n, Fractional b)+    => BinSpec n a b+    -> Pointed (Finite n)+    -> (Maybe a, Maybe a)+binRange_ bs = \case+    Bot     -> ( Nothing         , Just (SV.head v))+    PElem i -> ( Just (v `SV.index` weaken i)+               , Just (v `SV.index` shift i )+               )+    Top     -> ( Just (SV.last v), Nothing         )+  where+    v        = binSpecIntervals @n bs++-- | Extract the minimum and maximum of the range indicabed by a given+-- 'Bin'.+--+-- A 'Nothing' value indicates that we are outside of the normal range of+-- the 'BinSpec', so is "unbounded" in that direction.+binRange+    :: forall n a b s. (KnownNat n, Fractional b, Reifies s (BinSpec n a b))+    => Bin s n+    -> (Maybe a, Maybe a)+binRange = binRange_ (reflect (Proxy @s)) . binIx++-- | Extract the minimum of the range indicabed by a given 'Bin'.+--+-- A 'Nothing' value means that the original value was below the minimum+-- limit of the 'BinSpec', so is "unbounded" in the lower direction.+binMin+    :: forall n a b s. (KnownNat n, Fractional b, Reifies s (BinSpec n a b))+    => Bin s n+    -> Maybe a+binMin = fst . binRange++-- | Extract the maximum of the range indicabed by a given 'Bin'.+--+-- A 'Nothing' value means that the original value was above the maximum+-- limit of the 'BinSpec', so is "unbounded" in the upper direction.+binMax+    :: forall n a b s. (KnownNat n, Fractional b, Reifies s (BinSpec n a b))+    => Bin s n+    -> Maybe a+binMax = snd . binRange++-- | Display the interval maintained by a 'Bin'.+displayBin+    :: forall n a b s. (KnownNat n, Fractional b, Reifies s (BinSpec n a b))+    => (a -> String)        -- ^ how to display a value+    -> Bin s n+    -> String+displayBin f b = printf "%s .. %s" mn' mx'+  where+    (mn, mx) = binRange b+    mn' = case mn of+            Nothing -> "(-inf"+            Just m  -> "[" ++ f m+    mx' = case mx of+            Nothing -> "+inf)"+            Just m  -> f m ++ ")"++-- | Display the interval maintained by a 'Bin', if the 'Bin' contains+-- a 'Double'.+displayBinDouble+    :: forall n b s. (KnownNat n, Fractional b, Reifies s (BinSpec n Double b))+    => Int                      -- ^ number of decimal places to round+    -> Bin s n+    -> String+displayBinDouble d = displayBin (printf ("%." ++ show d ++ "f"))++instance (KnownNat n, Show a, Fractional b, Reifies s (BinSpec n a b)) => Show (Bin s n) where+    showsPrec d b = showParen (d > 10) $+      showString "Bin " . showString (displayBin @n show b)++-- | Generate a histogram: given a container of @a@s, generate a frequency+-- map of how often values in a given discrete bin occurred.+--+-- @+-- xs :: [Double]+-- xs = [1..100]+--+-- main :: IO ()+-- main = withBinner (logBS @10 5 50) $ \toBin ->+--     mapM_ (\(b, n) -> putStrLn (displayBinDouble 4 b ++ "\t" ++ show n))+--   . M.toList+--   $ binFreq toBin xs+-- @+--+-- @+-- (-inf .. 5.0000)        4+-- [5.0000 .. 6.2946)      2+-- [6.2946 .. 7.9245)      1+-- [7.9245 .. 9.9763)      2+-- [9.9763 .. 12.5594)     3+-- [12.5594 .. 15.8114)    3+-- [15.8114 .. 19.9054)    4+-- [19.9054 .. 25.0594)    6+-- [25.0594 .. 31.5479)    6+-- [31.5479 .. 39.7164)    8+-- [39.7164 .. 50.0000)    10+-- [50.0000 .. +inf)       51+-- @+binFreq+    :: forall n t a s. Foldable t+    => Binner s n a+    -> t a+    -> M.Map (Bin s n) Int+binFreq toBin = M.unionsWith (+) . map go . toList+  where+    go :: a -> M.Map (Bin s n) Int+    go x = M.singleton (toBin x) 1++-- | Construct a 'Bin' if you know the bin number you want to specify, or+-- if the bin is over or under the maximum.+fromIx :: Pointed (Finite n) -> Bin s n+fromIx = Bin++-- | Construct a 'Bin' if you know the bin number you want to specify.  See+-- 'fromIx' if you want to specify bins that are over or under the maximum,+-- as well.+fromFin :: Finite n -> Bin s n+fromFin = Bin . PElem++-- | A @'SomeBin' a n@ is @'Bin' s n@, except with the 'BinSpec' s hidden.+-- It's useful for returning out of 'withBinner'.+--+-- It has useful 'Eq' and 'Ord' instances.+--+-- To be able to "unify" two 'Bin's inside a 'SomeBin', use 'sameBinSpec'+-- to verify that the two 'SomeBin's were created with the same 'BinSpec'.+data SomeBin a n = forall s b. (Fractional b, Reifies s (BinSpec n a b)) +    => SomeBin { getSomeBin :: Bin s n }++deriving instance (KnownNat n, Show a) => Show (SomeBin a n)++-- | Compares if the ranges match.  Note that this is less performant than+-- comparing the original 'Bin's, or extracting and using 'sameBinSpec'.+instance (KnownNat n, Eq a) => Eq (SomeBin a n) where+    SomeBin x == SomeBin y = binRange x == binRange y++-- | Lexicographical ordering -- compares the lower bound, then the upper+-- bounds.  Note that this is less performant than comparing the original+-- 'Bin's, or extracting and using 'sameBinSpec'+instance (KnownNat n, Ord a) => Ord (SomeBin a n) where+    compare (SomeBin x) (SomeBin y) = compare (binRange x) (binRange y)++-- | Verify that the two reified 'BinSpec' types refer to the same one,+-- allowing you to use functions like '==' and 'compare' on 'Bin's that you+-- get out of a 'SomeBin'.+sameBinSpec+    :: forall s t n a b p. (Reifies s (BinSpec n a b), Reifies t (BinSpec n a b), KnownNat n, Eq a, Fractional b)+    => p s+    -> p t+    -> Maybe (s :~: t)+sameBinSpec _ _ = do+    guard $ binSpecIntervals bs1 == binSpecIntervals bs2+    pure (unsafeCoerce Refl)+  where+    bs1 = reflect (Proxy @s)+    bs2 = reflect (Proxy @t)