histogram-fill 0.3.1 → 0.4
raw patch · 3 files changed
+251/−105 lines, 3 files
Files
- Data/Histogram/Bin.hs +35/−5
- Data/Histogram/Fill.hs +215/−99
- histogram-fill.cabal +1/−1
Data/Histogram/Bin.hs view
@@ -72,8 +72,8 @@ -- Type classes ---------------------------------------------------------------- --- | This type represent some abstract data binning algorithms.--- It maps some value to integer indices.+-- | This type represent some abstract data binning algorithms. Such+-- algorithm maps sets of values to integer indices. -- -- Following invariant is expected to hold: --@@ -81,11 +81,11 @@ class Bin b where -- | Type of value to bin type BinValue b- -- | Convert from value to index. No bound checking- -- performed. Function must not fail for any input.+ -- | Convert from value to index. Function must not fail for any+ -- input and should produce out of range indices for invalid input. toIndex :: b -> BinValue b -> Int -- | Convert from index to value. Returned value should correspond- -- to "center" of bin. Definition of center is left for definition+ -- to center of bin. Definition of center is left for definition -- of instance. Funtion may fail for invalid indices but -- encouraged not to do so. fromIndex :: b -> Int -> BinValue b@@ -143,6 +143,10 @@ ---------------------------------------------------------------- -- | Simple binning algorithm which map continous range of bins onto -- indices. Each number correcsponds to different bin+--+-- 1. Lower bound (inclusive)+--+-- 2. Upper bound (inclusive) data BinI = BinI {-# UNPACK #-} !Int -- Lower bound (inclusive) {-# UNPACK #-} !Int -- Upper bound (inclusive)@@ -190,6 +194,12 @@ ---------------------------------------------------------------- -- | Integer bins with size which differ from 1.+--+-- 1. Low bound+--+-- 2. Bin size+--+-- 3. Number of bins data BinInt = BinInt {-# UNPACK #-} !Int -- Low bound {-# UNPACK #-} !Int -- Bin size@@ -281,6 +291,12 @@ -- -- Note that due to GHC bug #2271 this toIndex is really slow (20x -- slowdown with respect to BinD) and use of BinD is recommended+--+-- 1. Lower bound+--+-- 2. Size of bin+--+-- 3. Number of bins data BinF f = BinF {-# UNPACK #-} !f -- Lower bound {-# UNPACK #-} !f -- Size of bin {-# UNPACK #-} !Int -- Number of bins@@ -355,6 +371,12 @@ ---------------------------------------------------------------- -- | Floaintg point bins with equal sizes. If you work with Doubles -- this data type should be used instead of BinF.+--+-- 1. Lower bound+--+-- 2. Size of bin+--+-- 3. Number of bins data BinD = BinD {-# UNPACK #-} !Double -- Lower bound {-# UNPACK #-} !Double -- Size of bin {-# UNPACK #-} !Int -- Number of bins@@ -432,6 +454,14 @@ -- Log-scale bin ---------------------------------------------------------------- -- | Logarithmic scale bins.+--+-- 1. Lower bound+--+-- 2. Upper bound+--+-- 2. Increment ratio+--+-- 3. Number of bins data LogBinD = LogBinD Double -- Low border Double -- Hi border
Data/Histogram/Fill.hs view
@@ -6,12 +6,10 @@ -- Maintainer : Alexey Khudyakov <alexey.skladnoy@gmail.com> -- Stability : experimental ----- Module with algorithms for histogram filling. This is pure wrapper--- around stateful histograms.+-- Stateful and pure (still stateful under the hood) accumulators. ---module Data.Histogram.Fill ( -- * Histogram builders API+module Data.Histogram.Fill ( -- * Builder type class HistBuilder(..)- , FillableData(..) , (<<-) , (<<-|) , (<<?)@@ -22,38 +20,46 @@ , feedOne , freezeHBuilderM , joinHBuilderM- , joinHBuilderMonoidM , treeHBuilderM- , treeHBuilderMonoidM -- ** Stateless , HBuilder , toHBuilderST , toHBuilderIO , joinHBuilder- , joinHBuilderMonoid , treeHBuilder- , treeHBuilderMonoid -- * Histogram constructors , module Data.Histogram.Bin , mkSimple , mkWeighted , mkMonoidal+ , mkFolder -- * Fill histograms , fillBuilder -- * Auxillary functions+ -- $auxillary , forceInt , forceDouble , forceFloat+ -- * Deprecated+ , joinHBuilderMonoidM+ , joinHBuilderMonoid+ , treeHBuilderMonoidM+ , treeHBuilderMonoid + -- * Examples+ -- $examples ) where import Control.Applicative import Control.Monad (when,liftM,liftM2)-import Control.Monad.ST +import Control.Monad.ST import Control.Monad.Primitive +import Data.STRef import Data.Monoid (Monoid(..)) -- import Data.Monoid.Statistics (StatMonoid) import Data.Vector.Unboxed (Unbox)+import qualified Data.Foldable as F (Foldable,mapM_)+import qualified Data.Traversable as F (Traversable,mapM) import Data.Histogram import Data.Histogram.Bin@@ -63,38 +69,34 @@ -- Type class ---------------------------------------------------------------- --- | Data type which could be put into histogram.-class FillableData d where- -- | Lift putter function to lift putter function to use data type.- fillData :: PrimMonad m => (a -> m ()) -> d a -> m ()--instance FillableData Maybe where- fillData f (Just x) = f x- fillData _ Nothing = return ()-instance FillableData [] where- fillData = mapM_---- | Histogram builder typeclass. Instance of this class contain--- instructions how to build histograms.+-- | Type class for stateful accumulators. In this module they are+-- called builders. Every builder is parametrized by two+-- types. First one is type of values which are fed to accumulator+-- and second one is type of values which could be extracted from+-- it.+--+-- Every instance of 'HBuilder' should be instance of 'Functor' too+-- and satisfy 'fmap' == 'modifyOut'. class HistBuilder h where- -- | Convert output of histogram- modifyOut :: (b -> b') -> h a b -> h a b'- -- | Convert input type of histogram from a to a'- modifyIn :: (a' -> a) -> h a b -> h a' b- -- | Make input function accept value only - modifyWith :: FillableData d => h a b -> h (d a) b- -- | Add cut to histogram. Value would be putted into histogram only if condition is true.- addCut :: (a -> Bool) -> h a b -> h a b+ -- | Apply function to output of histogram.+ modifyOut :: (b -> b') -> h a b -> h a b'+ -- | Change input of builder by applying function to it.+ modifyIn :: (a' -> a) -> h a b -> h a' b+ -- | Put all values in container into builder + fromContainer :: F.Foldable f => h a b -> h (f a) b+ -- | Add cut to histogram. Value would be putted into histogram+ -- only if condition is true. + addCut :: (a -> Bool) -> h a b -> h a b --- | Modify input of builder +-- | Modify input of builder (<<-) :: HistBuilder h => h a b -> (a' -> a) -> h a' b (<<-) = flip modifyIn {-# INLINE (<<-) #-} -- | Modify input of builder to use composite input-(<<-|) :: (HistBuilder h, FillableData d) => h a b -> (a' -> d a) -> h a' b-h <<-| f = modifyWith h <<- f+(<<-|) :: (HistBuilder h, F.Foldable f) => h a b -> (a' -> f a) -> h a' b+h <<-| f = fromContainer h <<- f {-# INLINE (<<-|) #-} -- | Add cut for input@@ -114,20 +116,84 @@ infixr 4 -<< +-- $examples+--+-- All examples will make use of operators to create builders. It's+-- possible to avoid their use but operators offer clear notation and+-- compose nicely in pipeline. Also note that data flows from right to+-- left as with '.' operator.+--+-- First example just counts ints in in [0..4] inclusive range.+-- 'fillBuilder' is used to put all values into accumulator.+--+-- > ghci> let h = forceInt -<< mkSimple (BinI 0 4)+-- > ghci> fillBuilder h [0,0,0,1,1,2,3,4,4,4]+-- > # Histogram+-- > # Underflows = 0+-- > # Overflows = 0+-- > # BinI+-- > # Low = 0+-- > # High = 4+-- > 0 3+-- > 1 2+-- > 2 1+-- > 3 1+-- > 4 3+--+-- More involved example only accept even numbers. Filtering could be+-- achieved with either 'addCut' or '<<?' operator.+--+-- > forceInt -<< mkSimple (BinI 0 4) <<? even+--+-- Although for example above same result could be acheved by+-- filtering of input it doesn't work when multiple histograms with+-- different cuts are filled simultaneously.+--+-- Next example illustrate use of applicative interface. Here two+-- histograms are filled at the same time. First accept only even+-- numbers and second only odd ones. Results are put into the tuple.+--+-- > (,) <$> +-- > (forceInt -<< mkSimple (BinI 0 4) <<? even)+-- > (forceInt -<< mkSimple (BinI 0 4) <<? odd)+--+-- Another approach is to use 'joinHBuilder' to simultaneously fill+-- list (or any other 'Travesable'). +--+-- > joinHBuilder [+-- > forceInt -<< mkSimple (BinI 0 4) <<? even+-- > , forceInt -<< mkSimple (BinI 0 4) <<? odd+-- > ]+--+-- If one wants to collect result from many histograms he can take an+-- advantage of 'Monoid' instance of 'HBuilder'. Example below+-- concatenates string outputs of individual histograms.+--+-- > mconcat [+-- > show . forceInt -<< mkSimple (BinI 0 4) <<? even+-- > , show . forceInt -<< mkSimple (BinI 0 4) <<? odd+-- > ]++ ------------------------------------------------------------------- ST based builder+-- Monadic builder ---------------------------------------------------------------- --- | Stateful histogram builder.+-- | Stateful histogram builder. There is no direct way to construct+-- such builder. Only way to do it is to create 'HBuilder' and use+-- 'toHBuilderST' or 'toHBuilderIO'.+--+-- It's useful when result should be extracted many times from the+-- same accumulator. data HBuilderM m a b = HBuilderM { hbInput :: a -> m () , hbOutput :: m b } instance PrimMonad m => HistBuilder (HBuilderM m) where- modifyIn f h = h { hbInput = hbInput h . f }- addCut f h = h { hbInput = \x -> when (f x) (hbInput h x) }- modifyWith h = h { hbInput = fillData (hbInput h) } - modifyOut f h = h { hbOutput = f `liftM` hbOutput h }+ modifyIn f h = h { hbInput = hbInput h . f }+ addCut f h = h { hbInput = \x -> when (f x) (hbInput h x) }+ fromContainer h = h { hbInput = F.mapM_ (hbInput h) }+ modifyOut f h = h { hbOutput = f `liftM` hbOutput h } instance PrimMonad m => Functor (HBuilderM m a) where fmap = modifyOut@@ -140,8 +206,17 @@ b <- hbOutput g return (a b) }- --- | Put one value into histogram++instance (PrimMonad m, Monoid b) => Monoid (HBuilderM m a b) where+ mempty = HBuilderM { hbInput = \_ -> return ()+ , hbOutput = return mempty+ }+ mappend h1 h2 = mappend <$> h1 <*> h2+ mconcat = fmap mconcat . joinHBuilderM+ {-# INLINE mempty #-}+ {-# INLINE mconcat #-}++-- | Put one item into histogram feedOne :: PrimMonad m => HBuilderM m a b -> a -> m () feedOne = hbInput {-# INLINE feedOne #-}@@ -152,106 +227,112 @@ freezeHBuilderM = hbOutput {-# INLINE freezeHBuilderM #-} --- | Join list of builders into one builder-joinHBuilderM :: PrimMonad m => [HBuilderM m a b] -> HBuilderM m a [b]-joinHBuilderM hs = HBuilderM { hbInput = \x -> mapM_ (flip hbInput x) hs- , hbOutput = mapM hbOutput hs+-- | Join histogram builders in container+joinHBuilderM :: (F.Traversable f, PrimMonad m) => f (HBuilderM m a b) -> HBuilderM m a (f b)+joinHBuilderM hs = HBuilderM { hbInput = \x -> F.mapM_ (flip hbInput x) hs+ , hbOutput = F.mapM hbOutput hs } {-# INLINE joinHBuilderM #-} --- | Join list of builders into one builders-joinHBuilderMonoidM :: (PrimMonad m, Monoid b) => [HBuilderM m a b] -> HBuilderM m a b-joinHBuilderMonoidM = fmap mconcat . joinHBuilderM-{-# INLINE joinHBuilderMonoidM #-}--treeHBuilderM :: PrimMonad m => [HBuilderM m a b -> HBuilderM m a' b'] -> HBuilderM m a b -> HBuilderM m a' [b']-treeHBuilderM fs h = joinHBuilderM $ map ($ h) fs+-- | Apply functions to builder+treeHBuilderM :: (PrimMonad m, F.Traversable f) => f (HBuilderM m a b -> HBuilderM m a' b') -> HBuilderM m a b -> HBuilderM m a' (f b')+treeHBuilderM fs h = joinHBuilderM $ fmap ($ h) fs {-# INLINE treeHBuilderM #-} -treeHBuilderMonoidM :: (PrimMonad m, Monoid b') => - [HBuilderM m a b -> HBuilderM m a' b'] -> HBuilderM m a b -> HBuilderM m a' b'-treeHBuilderMonoidM fs h = joinHBuilderMonoidM $ map ($ h) fs-{-# INLINE treeHBuilderMonoidM #-}-- ------------------------------------------------------------------- Stateless +-- Stateless ---------------------------------------------------------------- -- | Stateless histogram builder-newtype HBuilder a b = HBuilder { toHBuilderST :: (forall s . ST s (HBuilderM (ST s) a b)) - -- ^ Convert builder to stateful builder in 'ST' monad+newtype HBuilder a b = HBuilder { toHBuilderST :: (forall s . ST s (HBuilderM (ST s) a b))+ -- ^ Convert builder to stateful builder in ST monad } -- | Convert builder to builder in IO monad toHBuilderIO :: HBuilder a b -> IO (HBuilderM IO a b)-toHBuilderIO (HBuilder h) = do +toHBuilderIO (HBuilder h) = do builder <- stToIO h- return (HBuilderM - (stToIO . hbInput builder) + return (HBuilderM+ (stToIO . hbInput builder) (stToIO $ hbOutput builder)) {-# INLINE toHBuilderIO #-}- + instance HistBuilder (HBuilder) where- modifyIn f (HBuilder h) = HBuilder (modifyIn f <$> h)- addCut f (HBuilder h) = HBuilder (addCut f <$> h)- modifyWith (HBuilder h) = HBuilder (modifyWith <$> h)- modifyOut f (HBuilder h) = HBuilder (modifyOut f <$> h)+ modifyIn f (HBuilder h) = HBuilder (modifyIn f <$> h)+ addCut f (HBuilder h) = HBuilder (addCut f <$> h)+ fromContainer (HBuilder h) = HBuilder (fromContainer <$> h)+ modifyOut f (HBuilder h) = HBuilder (modifyOut f <$> h) instance Functor (HBuilder a) where fmap = modifyOut instance Applicative (HBuilder a) where pure x = HBuilder (return $ pure x)- (HBuilder f) <*> (HBuilder g) = HBuilder $ liftM2 (<*>) f g + (HBuilder f) <*> (HBuilder g) = HBuilder $ liftM2 (<*>) f g+instance Monoid b => Monoid (HBuilder a b) where+ mempty = HBuilder (return mempty)+ mappend h g = mappend <$> h <*> g+ mconcat = fmap mconcat . joinHBuilder+ {-# INLINE mempty #-}+ {-# INLINE mconcat #-} --- | Join list of builders-joinHBuilder :: [HBuilder a b] -> HBuilder a [b]-joinHBuilder hs = HBuilder (joinHBuilderM <$> mapM toHBuilderST hs)+-- | Join hitogram builders in container.+joinHBuilder :: F.Traversable f => f (HBuilder a b) -> HBuilder a (f b)+joinHBuilder hs = HBuilder (joinHBuilderM <$> F.mapM toHBuilderST hs) {-# INLINE joinHBuilder #-} --- | Join list of builders-joinHBuilderMonoid :: Monoid b => [HBuilder a b] -> HBuilder a b-joinHBuilderMonoid = modifyOut mconcat . joinHBuilder-{-# INLINE joinHBuilderMonoid #-}--treeHBuilder :: [HBuilder a b -> HBuilder a' b'] -> HBuilder a b -> HBuilder a' [b']-treeHBuilder fs h = joinHBuilder $ map ($ h) fs+-- | Apply function to builder+treeHBuilder :: F.Traversable f => f (HBuilder a b -> HBuilder a' b') -> HBuilder a b -> HBuilder a' (f b')+treeHBuilder fs h = joinHBuilder $ fmap ($ h) fs {-# INLINE treeHBuilder #-} -treeHBuilderMonoid :: Monoid b' => [HBuilder a b -> HBuilder a' b'] -> HBuilder a b -> HBuilder a' b'-treeHBuilderMonoid fs h = joinHBuilderMonoid $ map ($ h) fs-{-# INLINE treeHBuilderMonoid #-} ---------------------------------------------------------------- -- Constructors ---------------------------------------------------------------- +-- | Create builder. Bin content will be incremented by 1 for each+-- item put into histogram mkSimple :: (Bin bin, Unbox val, Num val ) => bin -> HBuilder (BinValue bin) (Histogram bin val)-mkSimple bin = +mkSimple bin = HBuilder $ do acc <- newMHistogram 0 bin- return $ HBuilderM { hbInput = fillOne acc- , hbOutput = freezeHist acc- }+ return HBuilderM { hbInput = fillOne acc+ , hbOutput = freezeHist acc+ } {-# INLINE mkSimple #-} +-- | Create builder. Bin content will incremented by weight supplied+-- for each item put into histogram mkWeighted :: (Bin bin, Unbox val, Num val ) => bin -> HBuilder (BinValue bin,val) (Histogram bin val) mkWeighted bin = HBuilder $ do acc <- newMHistogram 0 bin- return $ HBuilderM { hbInput = fillOneW acc- , hbOutput = freezeHist acc- }+ return HBuilderM { hbInput = fillOneW acc+ , hbOutput = freezeHist acc+ } {-# INLINE mkWeighted #-} +-- | Create builder. New value wil be mappended to current content of+-- a bin for each item put into histogram mkMonoidal :: (Bin bin, Unbox val, Monoid val ) => bin -> HBuilder (BinValue bin,val) (Histogram bin val) mkMonoidal bin = HBuilder $ do acc <- newMHistogram mempty bin- return $ HBuilderM { hbInput = fillMonoid acc- , hbOutput = freezeHist acc- }+ return HBuilderM { hbInput = fillMonoid acc+ , hbOutput = freezeHist acc+ } {-# INLINE mkMonoidal #-} ++-- | Create histogram builder which just does ordinary pure fold. It+-- is intended for use when some fold should be performed together+-- with histogram filling+mkFolder :: b -> (a -> b -> b) -> HBuilder a b+mkFolder a f = HBuilder $ do ref <- newSTRef a+ return HBuilderM { hbInput = \x -> modifySTRef ref (f x)+ , hbOutput = readSTRef ref+ }+{-# INLINE mkFolder #-}+ -- mkMonoidalAcc :: (Bin bin, Unbox val, StatMonoid val a -- ) => bin -> HBuilder (BinValue bin,a) (Histogram bin val) -- mkMonoidalAcc bin = HBuilder $ do acc <- newMHistogram mempty bin@@ -264,22 +345,57 @@ -- Actual filling of histograms ---------------------------------------------------------------- -fillBuilder :: HBuilder a b -> [a] -> b-fillBuilder hb xs = +-- | Fill histogram builder.+fillBuilder :: F.Foldable f => HBuilder a b -> f a -> b+fillBuilder hb xs = runST $ do h <- toHBuilderST hb- mapM_ (feedOne h) xs+ F.mapM_ (feedOne h) xs freezeHBuilderM h ---------------------------------------------------------------- --- | Function used to restrict type of histrogram.+-- $auxillary+--+-- In some cases builder constructors do not constrain output type+-- enough. Output type is still parametric in value type of histogram.+-- Functions below are just 'id' function with more restrictive+-- signature.+--+-- In example below 'forceInt' used to fix type of histogram to+-- 'Histogram BinI Int'. Without it compiler cannot infer type of+-- intermediate histogram.+--+-- > show . forceInt -<< mkSimple (BinI 1 10)+ forceInt :: Histogram bin Int -> Histogram bin Int forceInt = id --- | Function used to restrict type of histrogram. forceDouble :: Histogram bin Double -> Histogram bin Double forceDouble = id --- | Function used to restrict type of histrogram. forceFloat :: Histogram bin Float -> Histogram bin Float forceFloat = id++----------------------------------------------------------------+-- | Join list of builders into one builders+joinHBuilderMonoidM :: (PrimMonad m, Monoid b) => [HBuilderM m a b] -> HBuilderM m a b+joinHBuilderMonoidM = mconcat+{-# INLINE joinHBuilderMonoidM #-}+{-# DEPRECATED joinHBuilderMonoidM "Use mconcat instead. Will be removed in 0.5" #-}++-- | Join list of builders+joinHBuilderMonoid :: Monoid b => [HBuilder a b] -> HBuilder a b+joinHBuilderMonoid = mconcat+{-# INLINE joinHBuilderMonoid #-}+{-# DEPRECATED joinHBuilderMonoid "Use mconcat instead. Will be removed in 0.5" #-}++treeHBuilderMonoidM :: (PrimMonad m, Monoid b') =>+ [HBuilderM m a b -> HBuilderM m a' b'] -> HBuilderM m a b -> HBuilderM m a' b'+treeHBuilderMonoidM fs h = joinHBuilderMonoidM $ map ($ h) fs+{-# INLINE treeHBuilderMonoidM #-}+{-# DEPRECATED treeHBuilderMonoidM "Will be removed in 0.5" #-}++treeHBuilderMonoid :: Monoid b' => [HBuilder a b -> HBuilder a' b'] -> HBuilder a b -> HBuilder a' b'+treeHBuilderMonoid fs h = joinHBuilderMonoid $ map ($ h) fs+{-# INLINE treeHBuilderMonoid #-}+{-# DEPRECATED treeHBuilderMonoid "Will be removed in 0.5" #-}
histogram-fill.cabal view
@@ -1,5 +1,5 @@ Name: histogram-fill-Version: 0.3.1+Version: 0.4 Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE