diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,25 +1,33 @@ +Changes in 0.8.2.0 + + * Smart constructors for BinF and BinD check that bin number is not + negative. + * Fixed bug in `binInt' + * Fields of `Histogram' data type are strict now. + * Compatibility with GHC 7.8 + + Changes in 0.8.1.0 * Constructor of @HBuilderM@ exported. - Changes in 0.8.0.0 - * @toHBuilderM@ added and internal definition of @HBuilder@ is - changed. It required adding dependency on @monad-primitive@. +Changes in 0.8.0.0 - * @joinHBuilder@ and @treeHBuilder@ are deprecated. + * `toHBuilderM' added and internal definition of `HBuilder' is + changed. It required adding dependency on @monad-primitive@. + * `joinHBuilder' and @treeHBuilder@ are deprecated. Changes in 0.7.4.0 * Function for searching for minimum/maximum added. - * @NFData@ instance is fixed. - Changes in 0.7.3.0 - * @mkStatefulBuilder@ is added and HBuilder constructor is exposed. +Changes in 0.7.3.0 + * `mkStatefulBuilder' is added and HBuilder constructor is exposed. * Indexing operators for immutable histograms are added. @@ -35,11 +43,11 @@ Changes in 0.7.0.0 - * mkFoldBuilder is added to @Data.Histogram.Fill@ - * fill functions in @Data.Histogram.ST@ are replaced with generic + * mkFoldBuilder is added to `Data.Histogram.Fill' + * fill functions in `Data.Histogram.ST' are replaced with generic variant. * Indexing for immutable histograms is added and special constructor - for first and last bin are added to @HistIndex@ data type. + for first and last bin are added to `HistIndex' data type. * Functions to calculate sum, minimum and maximum of immutable histogram are added. @@ -51,7 +59,6 @@ * mapData function is added. * Slicing histogram do not results in crash if indices are out of bounds. - * Eq instances for BinF and BinD are added. * NFData instance for Bin2D is fixed. diff --git a/Data/Histogram/Bin/BinF.hs b/Data/Histogram/Bin/BinF.hs --- a/Data/Histogram/Bin/BinF.hs +++ b/Data/Histogram/Bin/BinF.hs @@ -26,12 +26,15 @@ import Data.Histogram.Bin.Read --- | Floaintg point bins with equal sizes. --- --- Since 'BinF' is paramentric it couldn't be unpacked. So @BinF --- Double@ will be always slower than 'BinD'. For roundtripping use: +-- | Floating point bins of equal size. Use following function for +-- construction and inspection of value: -- -- > b = binFstep (lowerLimit b) (binSize b) (nBins b) +-- +-- Performance note. Since @BinF@ is parametric in its value it +-- could not be unpacked and every access to data will require +-- pointer indirection. 'BinD' is binning specialized to @Doubles@ +-- and it's always faster than @BinF Double@. data BinF f = BinF !f -- Lower bound !f -- Size of bin {-# UNPACK #-} !Int -- Number of bins @@ -51,7 +54,11 @@ -> f -- ^ Size of step -> f -- ^ Approximation of end of range -> BinF f -binFn from step to = BinF from step (round $ (to - from) / step) +binFn from step to + | n <= 0 = error "Data.Histogram.Bin.BinF.binFn: nonpositive number of bins" + | otherwise = BinF from step n + where + n = round $ (to - from) / step -- | Create bins binFstep :: RealFrac f => @@ -59,7 +66,10 @@ -> f -- ^ Size of step -> Int -- ^ Number of bins -> BinF f -binFstep = BinF +binFstep from step n + | n <= 0 = error "Data.Histogram.Bin.BinF.binFstep: nonpositive number of bins" + | step < 0 = BinF (from + step * fromIntegral n) (-step) n + | otherwise = BinF from step n -- | 'scaleBinF a b' scales BinF using linear transform 'a+b*x' scaleBinF :: (Show f, RealFrac f) => f -> f -> BinF f -> BinF f @@ -126,8 +136,8 @@ -- Floating point bin /Specialized for Double ---------------------------------------------------------------- --- | Floaintg point bins with equal sizes. If you work with Doubles --- this data type should be used instead of 'BinF'. Roundtripping is same as with 'BinF' +-- | Floating point bins of equal sizes. If you work with Doubles this +-- data type should be used instead of 'BinF'. data BinD = BinD {-# UNPACK #-} !Double -- Lower bound {-# UNPACK #-} !Double -- Size of bin {-# UNPACK #-} !Int -- Number of bins @@ -145,14 +155,22 @@ -> Double -- ^ Size of step -> Double -- ^ Approximation of end of range -> BinD -binDn from step to = BinD from step (round $ (to - from) / step) +binDn from step to + | n <= 0 = error "Data.Histogram.Bin.BinF.binDn: nonpositive number of bins" + | otherwise = BinD from step n + where + n = round $ (to - from) / step -- | Create bins binDstep :: Double -- ^ Begin of range -> Double -- ^ Size of step -> Int -- ^ Number of bins -> BinD -binDstep = BinD +binDstep from step n + | n <= 0 = error "Data.Histogram.Bin.BinF.binDstep: nonpositive number of bins" + | step < 0 = BinD (from + step * fromIntegral n) (-step) n + | otherwise = BinD from step n + -- | 'scaleBinF a b' scales BinF using linear transform 'a+b*x' scaleBinD :: Double -> Double -> BinD -> BinD diff --git a/Data/Histogram/Bin/BinInt.hs b/Data/Histogram/Bin/BinInt.hs --- a/Data/Histogram/Bin/BinInt.hs +++ b/Data/Histogram/Bin/BinInt.hs @@ -45,12 +45,14 @@ -> Int -- ^ Bin size -> Int -- ^ Upper bound -> BinInt -binIntN lo n hi - | n < 0 = error "Data.Histogram.Bin.BinInt.binIntN: negative bin size" - | n > rng = BinInt lo 1 rng - | otherwise = BinInt lo undefined n +binIntN lo n hi + | n < 0 = error "Data.Histogram.Bin.BinInt.binIntN: negative bin size" + | hi < lo = binIntN hi n lo + | n >= rng = BinInt lo 1 rng + | otherwise = BinInt lo (rng `div` n) size where - rng = hi - lo + 1 + size = rng `div` n + rng = hi - lo + 1 binIntStep :: Int -- ^ Lower bound -> Int -- ^ Bin size diff --git a/Data/Histogram/Bin/Classes.hs b/Data/Histogram/Bin/Classes.hs --- a/Data/Histogram/Bin/Classes.hs +++ b/Data/Histogram/Bin/Classes.hs @@ -53,7 +53,7 @@ -- of instance. Funtion may fail for invalid indices but -- encouraged not to do so. fromIndex :: b -> Int -> BinValue b - -- | Total number of bins. + -- | Total number of bins. Must be non-negative. nBins :: b -> Int -- | Check whether value in range. Have default -- implementation. Should satisfy: diff --git a/Data/Histogram/Generic.hs b/Data/Histogram/Generic.hs --- a/Data/Histogram/Generic.hs +++ b/Data/Histogram/Generic.hs @@ -113,8 +113,12 @@ -- [@bin@] binning. It should be instance of 'Bin'. Check that type class description for details. -- -- [@a@] type of bin content. -data Histogram v bin a = Histogram bin (Maybe (a,a)) (v a) +data Histogram v bin a = Histogram !bin !(Maybe (a,a)) !(v a) +#if MIN_VERSION_base(4,7,0) + deriving (Eq, Typeable) +#else deriving (Eq) +#endif -- | Create histogram from binning algorithm and vector with -- data. Overflows are set to Nothing. @@ -187,16 +191,19 @@ "# Overflows = \n" +#if !MIN_VERSION_base(4,7,0) + histTyCon :: String -> String -> TyCon #if MIN_VERSION_base(4,4,0) histTyCon = mkTyCon3 "histogram-fill" #else histTyCon m s = mkTyCon $ m ++ "." ++ s #endif +-- end MIN_VERSION_base(4,4,0) instance Typeable1 v => Typeable2 (Histogram v) where typeOf2 h = mkTyConApp (histTyCon "Data.Histogram.Generic" "Histogram") [typeOf1 $ histData h] - +#endif -- | Vector do not supply 'NFData' instance so let just 'seq' it and diff --git a/Data/Histogram/ST.hs b/Data/Histogram/ST.hs --- a/Data/Histogram/ST.hs +++ b/Data/Histogram/ST.hs @@ -17,6 +17,7 @@ , freezeHist ) where +import Control.Monad import Control.Monad.Primitive import qualified Data.Vector.Generic as G @@ -42,6 +43,12 @@ newMHistogram :: (PrimMonad m, Bin bin, M.MVector v a) => a -> bin -> m (MHistogram (PrimState m) v bin a) newMHistogram zero bin = do let n = nBins bin + -- NOTE: replicate will create vector of zero length requested + -- length is negative. Thus if number of bins is negative buffer + -- will be shorter than 2. And it's assumed that there's always at + -- least 2 bin. Consequently it could lead to memory corruption. + when (n < 0) $ + error "Data.Histogram.ST.newMHistogram: negative number of bins" a <- M.replicate (n + 2) zero return $ MHistogram n bin a {-# INLINE newMHistogram #-} diff --git a/README.markdown b/README.markdown deleted file mode 100644 --- a/README.markdown +++ /dev/null @@ -1,5 +0,0 @@ - - -This library for creation and filling histogams. It provides rich -composable interface for histogram builders and abstracts notion of -binning. diff --git a/histogram-fill.cabal b/histogram-fill.cabal --- a/histogram-fill.cabal +++ b/histogram-fill.cabal @@ -1,21 +1,20 @@ Name: histogram-fill -Version: 0.8.1.1 +Version: 0.8.2.0 Synopsis: Library for histograms creation. -Description: +Description: This is library for histograms filling. Its aim to provide - convenient way to create and fill histograms. + convenient way to create and fill histograms. Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE Author: Alexey Khudyakov Maintainer: Alexey Khudyakov -Homepage: https://bitbucket.org/Shimuuar/histogram-fill/ +Homepage: https://github.com/Shimuuar/histogram-fill/ Bug-reports: https://github.com/Shimuuar/histogram-fill/issues Category: Data Build-Type: Simple extra-source-files: - README.markdown ChangeLog source-repository head @@ -50,20 +49,6 @@ Data.Histogram.Bin.Extra Data.Histogram.Bin.Read Data.Histogram.ST - -test-suite tests - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: QC.hs - other-modules: QC.Instances - ghc-options: -Wall - build-depends: - base >=3 && < 5, - histogram-fill, - vector, - QuickCheck >= 2, - test-framework, - test-framework-quickcheck2 Benchmark benchmarks Type: exitcode-stdio-1.0 diff --git a/test/QC.hs b/test/QC.hs deleted file mode 100644 --- a/test/QC.hs +++ /dev/null @@ -1,125 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -import Data.Typeable - -import Test.QuickCheck -import Test.Framework (Test,testGroup,defaultMain) -import Test.Framework.Providers.QuickCheck2 (testProperty) - -import Data.Histogram -import Data.Histogram.Bin.MaybeBin -import QC.Instances () - - - ----------------------------------------------------------------- --- ----------------------------------------------------------------- -tests :: [Test] -tests = - [ testGroup "Bins" - [ testsBin (T :: T BinI) - , testsBin (T :: T BinInt) - , testsBin (T :: T (BinF Float)) - , testsBin (T :: T (BinF Float)) - , testsBin (T :: T BinD) - , testsBin (T :: T (BinEnum Char)) - , testsBin (T :: T LogBinD) - , testsBin (T :: T (MaybeBin BinI)) - , testsBin (T :: T (Bin2D BinI BinI)) - ] - , testGroup "fromIndex . toIndex == is" - [ testProperty "BinI" $ prop_FromTo (T :: T BinI) - , testProperty "BinEnum" $ prop_FromTo (T :: T (BinEnum Char)) - , testProperty "Bin2D" $ prop_FromTo (T :: T (Bin2D BinI BinI)) - ] - , testGroup "Sliceable bins" - [ testSliceBin (T :: T BinI) - , testSliceBin (T :: T BinInt) - , testSliceBin (T :: T (BinF Float)) - , testSliceBin (T :: T (BinF Float)) - , testSliceBin (T :: T BinD) - , testSliceBin (T :: T (BinEnum Char)) - , testSliceBin (T :: T LogBinD) - ] - , testGroup "Histogram" - [ testProperty "read . show" (isIdentity (readHistogram . show) :: Histogram BinI Int -> Bool) - ] - ] - -testsBin :: ( Read a, Show a, Show (BinValue a), Eq a, Typeable a - , Bin a - , Arbitrary a, Arbitrary (BinValue a) - ) => T a -> Test -testsBin t - = testGroup ("Bin test for " ++ show (typeOfT t)) - [ testProperty "read . show = id" $ prop_ReadShow t - , testProperty "toIndex . fromIndex = id" $ prop_ToFrom t - , testProperty "inRange" $ prop_InRange t - ] - -testSliceBin :: ( Show b, Typeable b, SliceableBin b, Arbitrary b - ) => T b -> Test -testSliceBin t - = testGroup ("Slice tests for" ++ show (typeOfT t)) - [ testProperty "N of bins" $ prop_sliceBin t - ] - - ----------------------------------------------------------------- --- Bin tests ----------------------------------------------------------------- - --- > read . show == id -prop_ReadShow :: (Read a, Show a, Eq a) => T a -> a -> Bool -prop_ReadShow _ = isIdentity (read . show) - --- > toIndex . fromIndex == id -prop_ToFrom :: Bin bin => T bin -> Int -> bin -> Property -prop_ToFrom _ i bin = - i >= 0 && i < nBins bin ==> isIdentity (toIndex bin . fromIndex bin) i - --- > fromIndex . toIndex == id --- Hold only for integral bins -prop_FromTo :: (Bin bin, Eq (BinValue bin)) => T bin -> BinValue bin -> bin -> Property -prop_FromTo _ x bin = - inRange bin x ==> isIdentity (fromIndex bin . toIndex bin) x - --- > inRange b x == indexInRange b x -prop_InRange :: (Bin bin) => T bin -> bin -> BinValue bin -> Bool -prop_InRange _ b x - = inRange b x == indexInRange (toIndex b x) - where - indexInRange i = i >= 0 && i < nBins b - --- Sliced bin have correct number of bins -prop_sliceBin :: (SliceableBin b) => T b -> b -> Gen Bool -prop_sliceBin _ bin = do - let n = nBins bin - i <- choose (0, n-1) - j <- choose (i, n-1) - return $ nBins (sliceBin i j bin) == (j - i + 1) - - - ----------------------------------------------------------------- --- Helpers ----------------------------------------------------------------- - -isIdentity :: Eq a => (a -> a) -> a -> Bool -isIdentity f x = x == f x - -data T a = T - -paramOfT :: T a -> a -paramOfT _ = undefined - -typeOfT :: Typeable a => T a -> TypeRep -typeOfT = typeOf . paramOfT - ----------------------------------------------------------------- --- Main ----------------------------------------------------------------- - -main :: IO () -main = - defaultMain tests diff --git a/test/QC/Instances.hs b/test/QC/Instances.hs deleted file mode 100644 --- a/test/QC/Instances.hs +++ /dev/null @@ -1,82 +0,0 @@ --- Yes I DO want orphans here -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE FlexibleInstances #-} -module QC.Instances() where - -import Control.Applicative -import Test.QuickCheck -import qualified Data.Vector.Unboxed as U - -import Data.Histogram -import Data.Histogram.Bin.MaybeBin - - - ----------------------------------------------------------------- --- Bin instances ----------------------------------------------------------------- - -instance Arbitrary BinI where - arbitrary = do - let maxI = 100 - lo <- choose (-maxI , maxI) - hi <- choose (lo , maxI) - return $ binI lo hi - -instance Arbitrary BinInt where - arbitrary = do - let maxI = 100 - base <- choose (-maxI,maxI) - step <- choose (1,10) - n <- choose (1,10^3) - return $ BinInt base step n - -instance (Arbitrary a, Ord a, Enum a) => Arbitrary (BinEnum a) where - arbitrary = do - l <- arbitrary - h <- suchThat arbitrary (>= l) - return $ binEnum l h - -instance Arbitrary (BinF Float) where - arbitrary = do - lo <- choose (-1.0e+3-1 , 1.0e+3) - n <- choose (1, 10^3) - hi <- choose (lo , 1.0e+3+1) - return $ binF lo n hi - -instance Arbitrary (BinF Double) where - arbitrary = do - lo <- choose (-1.0e+6-1 , 1.0e+6) - n <- choose (1, 10^6) - hi <- choose (lo , 1.0e+6+1) - return $ binF lo n hi - -instance Arbitrary BinD where - arbitrary = do - lo <- choose (-1.0e+6-1 , 1.0e+6) - n <- choose (1, 10^6) - hi <- choose (lo , 1.0e+6+1) - return $ binD lo n hi - -instance Arbitrary LogBinD where - arbitrary = do - lo <- choose (1.0e-6 , 1.0e+6) - n <- choose (1, 10^6) - hi <- choose (lo , 1.0e+6+1) - return $ logBinD lo n hi - -instance Arbitrary bin => Arbitrary (MaybeBin bin) where - arbitrary = MaybeBin <$> arbitrary - -instance (Arbitrary bx, Arbitrary by) => Arbitrary (Bin2D bx by) where - arbitrary = Bin2D <$> arbitrary <*> arbitrary - ----------------------------------------------------------------- --- Histogram instance ----------------------------------------------------------------- - -instance (Bin bin, U.Unbox a, Arbitrary bin, Arbitrary a) => Arbitrary (Histogram bin a) where - arbitrary = do - bin <- suchThat arbitrary ((<333) . nBins) - histogramUO bin <$> arbitrary <*> (U.fromList <$> vectorOf (nBins bin) arbitrary)