histogram-fill 0.6.2.0 → 0.7.0.0

raw patch · 7 files changed

+434/−96 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Histogram.hs +27/−10
• Data/Histogram/Fill.hs +33/−19
• Data/Histogram/Generic.hs +137/−39
• Data/Histogram/ST.hs +16/−26
• histogram-fill.cabal +14/−2
• test/QC.hs +125/−0
• test/QC/Instances.hs +82/−0

@@ -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   ----------------------------------------------------------------

@@ -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

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts   #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} -- | -- Module     : Data.Histogram -- Copyright  : Copyright (c) 2009, Alexey Khudyakov <alexey.skladnoy@gmail.com>@@ -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

@@ -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

@@ -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

@@ -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

@@ -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)