diff --git a/Data/Histogram.hs b/Data/Histogram.hs --- a/Data/Histogram.hs +++ b/Data/Histogram.hs @@ -12,14 +12,17 @@ -- 'Data.Histogram.Generic' but specialzed to unboxed vectors. Refer -- aforementioned module for documentation. module Data.Histogram ( -- * Immutable histogram - -- * Data type + -- * Immutable histograms Histogram , module Data.Histogram.Bin + -- ** Constructors , histogram , histogramUO - , HistIndex(..) - , histIndex - -- * Read histograms from string + -- ** Conversion to other data types + , asList + , asVector + -- * Serialization to strings + -- $serialization , readHistogram , readFileHistogram -- * Accessors @@ -28,10 +31,11 @@ , underflows , overflows , outOfRange - -- ** Convert to other data types - , asList - , asVector - -- * Modification + -- ** Indexing + , HistIndex(..) + , histIndex + , at + -- * Transformations , map , bmap , mapData @@ -42,6 +46,9 @@ -- * Folding , foldl , bfoldl + , sum + , minimum + , maximum -- * Slicing & rebinning , slice , rebin @@ -67,7 +74,7 @@ import Data.Histogram.Generic (HistIndex(..),histIndex) import Data.Histogram.Bin -import Prelude hiding (map,zip,foldl) +import Prelude hiding (map,zip,foldl,sum,maximum,minimum) @@ -119,6 +126,9 @@ => Histogram bin a -> Vector (BinValue bin, a) asVector = H.asVector +at :: (Bin bin, Unbox a) => Histogram bin a -> HistIndex bin -> a +at = H.at + ---------------------------------------------------------------- -- Modify histograms ---------------------------------------------------------------- @@ -148,7 +158,6 @@ convertBinning = H.convertBinning - ---------------------------------------------------------------- -- Folding ---------------------------------------------------------------- @@ -159,6 +168,14 @@ bfoldl :: (Bin bin, Unbox a) => (b -> BinValue bin -> a -> b) -> b -> Histogram bin a -> b bfoldl = H.bfoldl +sum :: (Bin bin, Unbox a, Num a) => Histogram bin a -> a +sum = foldl (+) 0 + +minimum :: (Bin bin, Unbox a, Ord a) => Histogram bin a -> a +minimum = H.minimum + +maximum :: (Bin bin, Unbox a, Ord a) => Histogram bin a -> a +maximum = H.maximum ---------------------------------------------------------------- diff --git a/Data/Histogram/Fill.hs b/Data/Histogram/Fill.hs --- a/Data/Histogram/Fill.hs +++ b/Data/Histogram/Fill.hs @@ -32,15 +32,19 @@ , joinHBuilder , treeHBuilder -- * Histogram constructors + -- ** Using unboxed vectors , module Data.Histogram.Bin , mkSimple , mkWeighted , mkMonoidal - , mkFolder - -- ** Generic versions + , mkFoldBuilder + -- ** Using generic vectors , mkSimpleG , mkWeightedG , mkMonoidalG + , mkFoldBuilderG + -- ** Pure fold + , mkFolder -- * Fill histograms , fillBuilder , fillBuilderVec @@ -323,13 +327,24 @@ mkMonoidal = mkMonoidalG {-# INLINE mkMonoidal #-} +-- | Create most generic histogram builder. +mkFoldBuilder :: (Bin bin, Unbox val) + => bin -- ^ Binning algorithm + -> val -- ^ Initial value + -> (val -> a -> val) -- ^ Folding function + -> HBuilder (BinValue bin, a) (Histogram bin val) +{-# INLINE mkFoldBuilder #-} +mkFoldBuilder = mkFoldBuilderG + + + -- | Create builder. Bin content will be incremented by 1 for each -- item put into histogram mkSimpleG :: (Bin bin, G.Vector v val, Num val ) => bin -> HBuilder (BinValue bin) (H.Histogram v bin val) mkSimpleG bin = HBuilder $ do acc <- newMHistogram 0 bin - return HBuilderM { hbInput = fillOne acc + return HBuilderM { hbInput = \x -> fill acc x (+) 1 , hbOutput = freezeHist acc } {-# INLINE mkSimpleG #-} @@ -338,24 +353,30 @@ -- for each item put into histogram mkWeightedG :: (Bin bin, G.Vector v val, Num val ) => bin -> HBuilder (BinValue bin,val) (H.Histogram v bin val) -mkWeightedG bin = HBuilder $ do - acc <- newMHistogram 0 bin - return HBuilderM { hbInput = fillOneW acc - , hbOutput = freezeHist acc - } +mkWeightedG bin = mkFoldBuilderG bin 0 (+) {-# INLINE mkWeightedG #-} -- | Create builder. New value wil be mappended to current content of -- a bin for each item put into histogram mkMonoidalG :: (Bin bin, G.Vector v val, Monoid val ) => bin -> HBuilder (BinValue bin,val) (H.Histogram v bin val) -mkMonoidalG bin = HBuilder $ do - acc <- newMHistogram mempty bin - return HBuilderM { hbInput = fillMonoid acc +mkMonoidalG bin = mkFoldBuilderG bin mempty mappend +{-# INLINE mkMonoidalG #-} + +-- | Create most generic histogram builder. +mkFoldBuilderG :: (Bin bin, G.Vector v val) + => bin -- ^ Binning algorithm + -> val -- ^ Initial value + -> (val -> a -> val) -- ^ Folding function + -> HBuilder (BinValue bin, a) (H.Histogram v bin val) +{-# INLINE mkFoldBuilderG #-} +mkFoldBuilderG bin x0 f = HBuilder $ do + acc <- newMHistogram x0 bin + return HBuilderM { hbInput = \(!x,!w) -> fill acc x f w , hbOutput = freezeHist acc } -{-# INLINE mkMonoidalG #-} + -- | Create histogram builder which just does ordinary pure fold. It -- is intended for use when some fold should be performed together -- with histogram filling @@ -370,13 +391,6 @@ {-# 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 --- return $ HBuilderM { hbInput = fillMonoidAccum acc --- , hbOutput = freezeHist acc --- } --- {-# INLINE mkMonoidalAcc #-} ---------------------------------------------------------------- -- Actual filling of histograms diff --git a/Data/Histogram/Generic.hs b/Data/Histogram/Generic.hs --- a/Data/Histogram/Generic.hs +++ b/Data/Histogram/Generic.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} -- | -- Module : Data.Histogram -- Copyright : Copyright (c) 2009, Alexey Khudyakov @@ -9,14 +10,17 @@ -- -- Generic immutable histograms. module Data.Histogram.Generic ( - -- * Data type + -- * Immutable histograms Histogram , module Data.Histogram.Bin + -- ** Constructors , histogram , histogramUO - , HistIndex(..) - , histIndex - -- * Read histograms from string + -- ** Conversion to other data types + , asList + , asVector + -- * Serialization to strings + -- $serialization , readHistogram , readFileHistogram -- * Accessors @@ -25,10 +29,11 @@ , underflows , overflows , outOfRange - -- ** Convert to other data types - , asList - , asVector - -- * Modification + -- ** Indexing + , HistIndex(..) + , histIndex + , at + -- * Transformations , map , bmap , mapData @@ -40,11 +45,15 @@ -- * Folding , foldl , bfoldl + , sum + , minimum + , maximum -- * Slicing & rebinning , slice , rebin , rebinFold -- * 2D histograms + -- $hist2D -- ** Slicing , sliceAlongX , sliceAlongY @@ -65,36 +74,33 @@ import qualified Data.Vector.Generic as G import Data.Maybe (fromMaybe) -import Data.Typeable -- (Typeable(..),Typeable1(..),Typeable2(..),mkTyConApp,mkTyCon) +import Data.Typeable import Data.Vector.Generic (Vector,(!)) import Text.Read -import Prelude hiding (map,zip,foldl) +import Prelude hiding (map,zip,foldl,sum,maximum,minimum) import qualified Prelude (zip) import Data.Histogram.Bin import Data.Histogram.Bin.Read + + ---------------------------------------------------------------- --- Data type and smart constructors +-- Data type & smart constructors & conversion ---------------------------------------------------------------- -- | Immutable histogram. Histogram consists of binning algorithm, --- optional number of under and overflows, and data. +-- optional number of under and overflows, and data. Type parameter +-- have following meaning: +-- +-- [@v@] type of vector used to store bin content. +-- +-- [@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) deriving (Eq) --- | Point inside histogram's domain. It could be either bin index or --- bin value. -data HistIndex b - = Index Int -- ^ Index for a bin - | Value (BinValue b) -- ^ Value - deriving (Typeable) - --- | Convert 'HistIndex' to actual index -histIndex :: Bin b => b -> HistIndex b -> Int -histIndex _ (Index i) = i -histIndex b (Value x) = toIndex b x - -- | Create histogram from binning algorithm and vector with -- data. Overflows are set to Nothing. -- @@ -110,11 +116,51 @@ | nBins b == G.length v = Histogram b uo v | otherwise = error "Data.Histogram.Generic.histogramUO: number of bins and vector size doesn't match" +-- | Convert histogram data to list. +asList :: (Vector v a, Bin bin) => Histogram v bin a -> [(BinValue bin, a)] +asList (Histogram bin _ arr) = + Prelude.zip (fromIndex bin <$> [0..]) (G.toList arr) +-- | Convert histogram data to vector +asVector :: (Bin bin, Vector v a, Vector v (BinValue bin,a)) + => Histogram v bin a -> v (BinValue bin, a) +asVector (Histogram bin _ arr) = + G.generate (nBins bin) $ \i -> (fromIndex bin i, arr ! i) + + + ---------------------------------------------------------------- -- Instances & reading histograms from strings ---------------------------------------------------------------- +-- $serialization +-- +-- 'Show' instance is abused for serialization and produces human +-- readable data like that: +-- +-- > # Histogram +-- > # Underflows = 0 +-- > # Overflows = 88 +-- > # BinI +-- > # Low = 0 +-- > # High = 9 +-- > 0 99 +-- > 1 91 +-- > 2 95 +-- > 3 81 +-- > 4 92 +-- > 5 105 +-- > 6 90 +-- > 7 79 +-- > 8 91 +-- > 9 89 +-- +-- It could be deserialize using 'readHistogram' function. 'Read' +-- instance coulde provided as well but it turned out to be +-- impractically slow. +-- +-- Serialization with cereal package is provided by histogram-fill-cereal + instance (Show a, Show (BinValue bin), Show bin, Bin bin, Vector v a) => Show (Histogram v bin a) where show h@(Histogram bin uo _) = "# Histogram\n" ++ showUO uo ++ show bin ++ unlines (fmap showT $ asList h) @@ -125,9 +171,19 @@ showUO Nothing = "# Underflows = \n" ++ "# Overflows = \n" + +histTyCon :: String -> String -> TyCon +#if MIN_VERSION_base(4,4,0) +histTyCon = mkTyCon3 "histogram-fill" +#else +histTyCon m s = mkTyCon $ m ++ "." ++ s +#endif + instance Typeable1 v => Typeable2 (Histogram v) where - typeOf2 h = mkTyConApp (mkTyCon "Data.Histogram.Generic.Histogram") [typeOf1 (histData h)] + typeOf2 h = mkTyConApp (histTyCon "Data.Histogram.Generic" "Histogram") [typeOf1 $ histData h] + + -- | Vector do not supply 'NFData' instance so let just 'seq' it and -- hope it's enough. Should be enough for unboxed vectors. instance (NFData a, NFData bin) => NFData (Histogram v bin a) where @@ -165,7 +221,7 @@ ---------------------------------------------------------------- --- Accessors & conversion +-- Accessors ---------------------------------------------------------------- -- | Histogram bins @@ -178,31 +234,42 @@ -- | Number of underflows underflows :: Histogram v bin a -> Maybe a -underflows (Histogram _ uo _) = fst <$> uo +underflows h = fst <$> outOfRange h -- | Number of overflows overflows :: Histogram v bin a -> Maybe a -overflows (Histogram _ uo _) = snd <$> uo +overflows h = snd <$> outOfRange h -- | Underflows and overflows outOfRange :: Histogram v bin a -> Maybe (a,a) outOfRange (Histogram _ uo _) = uo --- | Convert histogram data to list. -asList :: (Vector v a, Bin bin) => Histogram v bin a -> [(BinValue bin, a)] -asList (Histogram bin _ arr) = - Prelude.zip (fromIndex bin <$> [0..]) (G.toList arr) --- | Convert histogram data to vector -asVector :: (Bin bin, Vector v a, Vector v (BinValue bin,a)) - => Histogram v bin a -> v (BinValue bin, a) -asVector (Histogram bin _ arr) = - G.generate (nBins bin) $ \i -> (fromIndex bin i, arr G.! i) +-- | Point inside histogram's domain. It could be either bin index or +-- bin value. 'First' and 'Last' constructors are useful for +-- histogram slicing. +data HistIndex b + = Index Int -- ^ Index for a bin + | Value (BinValue b) -- ^ Value + | First -- ^ Bin with index 0 + | Last -- ^ Bin maximum index. + deriving (Typeable) +-- | Convert 'HistIndex' to actual index +histIndex :: Bin b => b -> HistIndex b -> Int +histIndex _ (Index i) = i +histIndex b (Value x) = toIndex b x +histIndex _ First = 0 +histIndex b Last = nBins b - 1 + +-- | Index histogtam. +at :: (Bin bin, Vector v a) => Histogram v bin a -> HistIndex bin -> a +at (Histogram bin _ v) i = v ! histIndex bin i + ---------------------------------------------------------------- --- Modify histograms +-- Transformation ---------------------------------------------------------------- -- | fmap lookalike. It's not possible to create Functor instance @@ -271,15 +338,29 @@ bfoldl f x0 (Histogram bin _ vec) = G.ifoldl' (\acc -> f acc . fromIndex bin) x0 vec +-- | Sum contents of all bins +sum :: (Bin bin, Vector v a, Num a) => Histogram v bin a -> a +sum = foldl (+) 0 +-- | Maximal bin value +minimum :: (Bin bin, Vector v a, Ord a) => Histogram v bin a -> a +minimum = G.minimum . histData +-- | Maximal bin value +maximum :: (Bin bin, Vector v a, Ord a) => Histogram v bin a -> a +maximum = G.maximum . histData + + + ---------------------------------------------------------------- -- Slicing and reducing histograms ---------------------------------------------------------------- -- | Slice histogram. Values/indices specify inclusive -- variant. Under/overflows are discarded. If requested value falls --- out of histogram range it will be truncated. +-- out of histogram range it will be truncated. Use 'First' or +-- 'Last' constructor if you need slice from first or to last bin +-- correspondingly. slice :: (SliceableBin bin, Vector v a) => HistIndex bin -- ^ Lower inclusive bound -> HistIndex bin -- ^ Upper inclusive bound @@ -330,9 +411,26 @@ off = case dir of CutLower -> G.length vec - n * k CutHigher -> 0 + + ---------------------------------------------------------------- -- 2D histograms ---------------------------------------------------------------- + +-- $hist2D +-- +-- Data in 2D histograms is stored in row major order. This in fact +-- dictated by implementation of 'Bin2D'. So indices of bin are +-- arranged in following pattern: +-- +-- > 0 1 2 3 +-- > 4 5 6 7 +-- > 8 9 10 11 +-- +-- Function from @AlongX@ family work with histogram slices along X +-- axis (as name suggest) which are contigous and therefor are +-- generally faster than @AlongY@ family. + -- | Get slice of 2D histogram along X axis. This function is faster -- than 'sliceAlongY' since no array reallocations is required diff --git a/Data/Histogram/ST.hs b/Data/Histogram/ST.hs --- a/Data/Histogram/ST.hs +++ b/Data/Histogram/ST.hs @@ -11,9 +11,7 @@ module Data.Histogram.ST ( -- * Mutable histograms MHistogram , newMHistogram - , fillOne - , fillOneW - , fillMonoid + , fill -- , fillMonoidAccum , unsafeFreezeHist , freezeHist @@ -21,7 +19,6 @@ import Control.Monad.Primitive -import Data.Monoid import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M @@ -49,30 +46,23 @@ return $ MHistogram n bin a {-# INLINE newMHistogram #-} --- Generic fill -fill :: (PrimMonad m, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> BinValue bin -> (a -> a) -> m () -fill (MHistogram n bin arr) !x f - | i < 0 = M.unsafeWrite arr n . f =<< M.unsafeRead arr n - | i >= n = M.unsafeWrite arr (n+1) . f =<< M.unsafeRead arr (n+1) - | otherwise = M.unsafeWrite arr i . f =<< M.unsafeRead arr i +-- | Generic fill. It could be seen as left fold with multiple +-- accumulators where accumulator is chosen by @BinValue bin@. +fill :: (PrimMonad m, M.MVector v a, Bin bin) + => MHistogram (PrimState m) v bin a -- ^ Mutable histogram to put value to + -> BinValue bin -- ^ Value being binned + -> (a -> b -> a) -- ^ Fold function + -> b -- ^ Value being put into histogram + -> m () +fill (MHistogram n bin arr) !x f val = do + a <- M.unsafeRead arr ix + M.unsafeWrite arr ix $! f a val where - i = toIndex bin x + i = toIndex bin x + ix | i < 0 = n + | i >= n = n+1 + | otherwise = i {-# INLINE fill #-} - --- | Put one value into histogram -fillOne :: (PrimMonad m, Num a, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> BinValue bin -> m () -fillOne h !x = fill h x (+1) -{-# INLINE fillOne #-} - --- | Put one value into histogram with weight -fillOneW :: (PrimMonad m, Num a, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> (BinValue bin, a) -> m () -fillOneW h (!x,!w) = fill h x (+w) -{-# INLINE fillOneW #-} - --- | Put one monoidal element -fillMonoid :: (PrimMonad m, Monoid a, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> (BinValue bin, a) -> m () -fillMonoid h (!x,!m) = fill h x (`mappend` m) -{-# INLINE fillMonoid #-} -- | Create immutable histogram from mutable one. This operation is diff --git a/histogram-fill.cabal b/histogram-fill.cabal --- a/histogram-fill.cabal +++ b/histogram-fill.cabal @@ -1,10 +1,23 @@ Name: histogram-fill -Version: 0.6.2.0 +Version: 0.7.0.0 Synopsis: Library for histograms creation. Description: This is library for histograms filling. Its aim to provide convenient way to create and fill histograms. . + Changes in 0.7.0.0 + . + * 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. + . + * Functions to calculate sum, minimum and maximum of immutable + histogram are added. + . Changes in 0.6.2.0 . * MaybeBin added. @@ -51,7 +64,6 @@ deepseq, primitive, vector >= 0.7 --- monoid-statistics == 0.1.* Exposed-modules: Data.Histogram Data.Histogram.Generic Data.Histogram.Fill diff --git a/test/QC.hs b/test/QC.hs new file mode 100644 --- /dev/null +++ b/test/QC.hs @@ -0,0 +1,125 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/test/QC/Instances.hs @@ -0,0 +1,82 @@ +-- 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)