diff --git a/Criterion.hs b/Criterion.hs --- a/Criterion.hs +++ b/Criterion.hs @@ -1,6 +1,7 @@ +{-# LANGUAGE RecordWildCards #-} -- | -- Module : Criterion --- Copyright : (c) 2009, 2010 Bryan O'Sullivan +-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com @@ -26,8 +27,9 @@ import Control.Monad ((<=<), forM_, replicateM_, when) import Control.Monad.Trans (liftIO) -import Criterion.Analysis (OutlierVariance(..), classifyOutliers, - outlierVariance, noteOutliers) +import Criterion.Analysis (OutlierEffect(..), OutlierVariance(..), + SampleAnalysis(..), analyseSample, + classifyOutliers, noteOutliers) import Criterion.Config (Config(..), Plot(..), Verbosity(..), fromLJ) import Criterion.Environment (Environment(..)) import Criterion.IO (note, prolix, summary) @@ -39,11 +41,8 @@ import qualified Data.Vector.Unboxed as U import Statistics.Function (create, minMax) import Statistics.KernelDensity (epanechnikovPDF) -import Statistics.Resampling (Resample, resample) -import Statistics.Resampling.Bootstrap (Estimate(..), bootstrapBCA) -import Statistics.Sample (mean, stdDev) +import Statistics.Resampling.Bootstrap (Estimate(..)) import Statistics.Types (Sample) -import System.Random.MWC (withSystemRandom) import System.Mem (performGC) import Text.Printf (printf) @@ -76,28 +75,24 @@ -> Criterion Sample runAndAnalyseOne env _desc b = do times <- runBenchmark env b - let numSamples = U.length times - let ests = [mean,stdDev] - numResamples <- getConfigItem $ fromLJ cfgResamples - _ <- prolix "bootstrapping with %d resamples\n" numResamples - res <- liftIO . withSystemRandom $ \gen -> - resample gen ests numResamples times :: IO [Resample] ci <- getConfigItem $ fromLJ cfgConfInterval - let [em,es] = bootstrapBCA ci times ests res - (effect, v) = outlierVariance em es (fromIntegral $ numSamples) - wibble = case effect of + numResamples <- getConfigItem $ fromLJ cfgResamples + _ <- prolix "analysing with %d resamples\n" numResamples + SampleAnalysis{..} <- liftIO $ analyseSample ci times numResamples + let OutlierVariance{..} = anOutliers + let wibble = case ovEffect of Unaffected -> "unaffected" :: String Slight -> "slightly inflated" Moderate -> "moderately inflated" Severe -> "severely inflated" - bs "mean" em + bs "mean" anMean summary "," - bs "std dev" es + bs "std dev" anStdDev summary "\n" vrb <- getConfigItem $ fromLJ cfgVerbosity - when (vrb == Verbose || (effect > Unaffected && vrb > Quiet)) $ do + when (vrb == Verbose || (ovEffect > Unaffected && vrb > Quiet)) $ do noteOutliers (classifyOutliers times) - _ <- note "variance introduced by outliers: %.3f%%\n" (v * 100) + _ <- note "variance introduced by outliers: %.3f%%\n" (ovFraction * 100) _ <- note "variance is %s by outliers\n" wibble return () return times diff --git a/Criterion/Analysis.hs b/Criterion/Analysis.hs --- a/Criterion/Analysis.hs +++ b/Criterion/Analysis.hs @@ -1,6 +1,7 @@ +{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} -- | -- Module : Criterion.Analysis --- Copyright : (c) 2009, 2010 Bryan O'Sullivan +-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com @@ -12,7 +13,11 @@ module Criterion.Analysis ( Outliers (..) + , OutlierEffect(..) , OutlierVariance(..) + , SampleAnalysis(..) + , analyseSample + , scale , analyseMean , countOutliers , classifyOutliers @@ -21,49 +26,20 @@ ) where import Control.Monad (when) +import Criterion.Analysis.Types import Criterion.IO (note) import Criterion.Measurement (secs) import Criterion.Monad (Criterion) -import qualified Data.Vector.Unboxed as U import Data.Int (Int64) import Data.Monoid (Monoid(..)) import Statistics.Function (sort) import Statistics.Quantile (weightedAvg) -import Statistics.Resampling.Bootstrap (Estimate(..)) -import Statistics.Sample (mean) +import Statistics.Resampling (Resample, resample) +import Statistics.Sample (mean, stdDev) import Statistics.Types (Sample) - --- | Outliers from sample data, calculated using the boxplot --- technique. -data Outliers = Outliers { - samplesSeen :: {-# UNPACK #-} !Int64 - , lowSevere :: {-# UNPACK #-} !Int64 - -- ^ More than 3 times the IQR below the first quartile. - , lowMild :: {-# UNPACK #-} !Int64 - -- ^ Between 1.5 and 3 times the IQR below the first quartile. - , highMild :: {-# UNPACK #-} !Int64 - -- ^ Between 1.5 and 3 times the IQR above the third quartile. - , highSevere :: {-# UNPACK #-} !Int64 - -- ^ More than 3 times the IQR above the third quartile. - } deriving (Eq, Read, Show) - --- | A description of the extent to which outliers in the sample data --- affect the sample mean and standard deviation. -data OutlierVariance = Unaffected -- ^ Less than 1% effect. - | Slight -- ^ Between 1% and 10%. - | Moderate -- ^ Between 10% and 50%. - | Severe -- ^ Above 50% (i.e. measurements - -- are useless). - deriving (Eq, Ord, Show) - -instance Monoid Outliers where - mempty = Outliers 0 0 0 0 0 - mappend = addOutliers - -addOutliers :: Outliers -> Outliers -> Outliers -addOutliers (Outliers s a b c d) (Outliers t w x y z) = - Outliers (s+t) (a+w) (b+x) (c+y) (d+z) -{-# INLINE addOutliers #-} +import System.Random.MWC (withSystemRandom) +import qualified Data.Vector.Unboxed as U +import qualified Statistics.Resampling.Bootstrap as B -- | Classify outliers in a data set, using the boxplot technique. classifyOutliers :: Sample -> Outliers @@ -87,12 +63,12 @@ -- | Compute the extent to which outliers in the sample data affect -- the sample mean and standard deviation. -outlierVariance :: Estimate -- ^ Bootstrap estimate of sample mean. - -> Estimate -- ^ Bootstrap estimate of sample - -- standard deviation. - -> Double -- ^ Number of original iterations. - -> (OutlierVariance, Double) -outlierVariance µ σ a = (effect, varOutMin) +outlierVariance :: B.Estimate -- ^ Bootstrap estimate of sample mean. + -> B.Estimate -- ^ Bootstrap estimate of sample + -- standard deviation. + -> Double -- ^ Number of original iterations. + -> OutlierVariance +outlierVariance µ σ a = OutlierVariance effect varOutMin where effect | varOutMin < 0.01 = Unaffected | varOutMin < 0.1 = Slight @@ -100,8 +76,8 @@ | otherwise = Severe varOutMin = (minBy varOut 1 (minBy cMax 0 µgMin)) / σb2 varOut c = (ac / a) * (σb2 - ac * σg2) where ac = a - c - σb = estPoint σ - µa = estPoint µ / a + σb = B.estPoint σ + µa = B.estPoint µ / a µgMin = µa / 2 σg = min (µgMin / 4) (σb / sqrt a) σg2 = σg * σg @@ -131,6 +107,33 @@ _ <- note "mean is %s (%d iterations)\n" (secs µ) iters noteOutliers . classifyOutliers $ a return µ + +-- | Multiply the 'Estimate's in an analysis by the given value, using +-- 'B.scale'. +scale :: Double -- ^ Value to multiply by. + -> SampleAnalysis -> SampleAnalysis +scale f s@SampleAnalysis{..} = s { + anMean = B.scale f anMean + , anStdDev = B.scale f anStdDev + } + +-- | Perform a bootstrap analysis of a non-parametric sample. +analyseSample :: Double -- ^ Confidence interval (between 0 and 1). + -> Sample -- ^ Sample data. + -> Int -- ^ Number of resamples to perform + -- when bootstrapping. + -> IO SampleAnalysis +analyseSample ci samples numResamples = do + let ests = [mean,stdDev] + resamples <- withSystemRandom $ \gen -> + resample gen ests numResamples samples :: IO [Resample] + let [estMean,estStdDev] = B.bootstrapBCA ci samples ests resamples + ov = outlierVariance estMean estStdDev (fromIntegral $ U.length samples) + return SampleAnalysis { + anMean = estMean + , anStdDev = estStdDev + , anOutliers = ov + } -- | Display a report of the 'Outliers' present in a 'Sample'. noteOutliers :: Outliers -> Criterion () diff --git a/Criterion/Analysis/Types.hs b/Criterion/Analysis/Types.hs new file mode 100644 --- /dev/null +++ b/Criterion/Analysis/Types.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards #-} +-- | +-- Module : Criterion.Analysis.Types +-- Copyright : (c) 2011 Bryan O'Sullivan +-- +-- License : BSD-style +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- Analysis types. + +module Criterion.Analysis.Types + ( + Outliers (..) + , OutlierEffect(..) + , OutlierVariance(..) + , SampleAnalysis(..) + ) where + +import Control.Applicative ((<$>), (<*>), empty, pure) +import Control.DeepSeq (NFData(rnf)) +import Data.Aeson.Types +import Data.Data (Data) +import Data.Int (Int64) +import Data.Monoid (Monoid(..)) +import Data.Typeable (Typeable) +import qualified Statistics.Resampling.Bootstrap as B + +-- | Outliers from sample data, calculated using the boxplot +-- technique. +data Outliers = Outliers { + samplesSeen :: {-# UNPACK #-} !Int64 + , lowSevere :: {-# UNPACK #-} !Int64 + -- ^ More than 3 times the interquartile range (IQR) below the + -- first quartile. + , lowMild :: {-# UNPACK #-} !Int64 + -- ^ Between 1.5 and 3 times the IQR below the first quartile. + , highMild :: {-# UNPACK #-} !Int64 + -- ^ Between 1.5 and 3 times the IQR above the third quartile. + , highSevere :: {-# UNPACK #-} !Int64 + -- ^ More than 3 times the IQR above the third quartile. + } deriving (Eq, Read, Show, Typeable, Data) + +instance NFData Outliers + +instance ToJSON Outliers where + toJSON Outliers{..} = object [ + "samplesSeen" .= samplesSeen + , "lowSevere" .= lowSevere + , "lowMild" .= lowMild + , "highMild" .= highMild + , "highSevere" .= highSevere + ] + +instance FromJSON Outliers where + parseJSON (Object v) = Outliers <$> + v .: "samplesSeen" <*> + v .: "lowSevere" <*> + v .: "lowMild" <*> + v .: "highMild" <*> + v .: "highSevere" + parseJSON _ = empty + +-- | A description of the extent to which outliers in the sample data +-- affect the sample mean and standard deviation. +data OutlierEffect = Unaffected -- ^ Less than 1% effect. + | Slight -- ^ Between 1% and 10%. + | Moderate -- ^ Between 10% and 50%. + | Severe -- ^ Above 50% (i.e. measurements + -- are useless). + deriving (Eq, Ord, Read, Show, Typeable, Data) + +instance NFData OutlierEffect + +instance ToJSON OutlierEffect where + toJSON Unaffected = "unaffected" + toJSON Slight = "slight" + toJSON Moderate = "moderate" + toJSON Severe = "severe" + +instance FromJSON OutlierEffect where + parseJSON (String t) = case t of + _| t== "unaffected" -> pure Unaffected + _| t== "slight" -> pure Slight + _| t== "moderate" -> pure Moderate + _| t== "severe" -> pure Severe + | otherwise -> empty + parseJSON _ = empty + +instance Monoid Outliers where + mempty = Outliers 0 0 0 0 0 + mappend = addOutliers + +addOutliers :: Outliers -> Outliers -> Outliers +addOutliers (Outliers s a b c d) (Outliers t w x y z) = + Outliers (s+t) (a+w) (b+x) (c+y) (d+z) +{-# INLINE addOutliers #-} + +-- | Analysis of the extent to which outliers in a sample affect its +-- mean and standard deviation. +data OutlierVariance = OutlierVariance { + ovEffect :: OutlierEffect + -- ^ Qualitative description of effect. + , ovFraction :: Double + -- ^ Quantitative description of effect (a fraction between 0 and 1). + } deriving (Eq, Read, Show, Typeable, Data) + +instance NFData OutlierVariance where + rnf OutlierVariance{..} = rnf ovEffect `seq` rnf ovFraction `seq` () + +instance ToJSON OutlierVariance where + toJSON OutlierVariance{..} = object [ + "effect" .= ovEffect + , "fraction" .= ovFraction + ] + +instance FromJSON OutlierVariance where + parseJSON (Object v) = OutlierVariance <$> + v .: "effect" <*> + v .: "fraction" + parseJSON _ = empty + +-- | Result of a bootstrap analysis of a non-parametric sample. +data SampleAnalysis = SampleAnalysis { + anMean :: B.Estimate + , anStdDev :: B.Estimate + , anOutliers :: OutlierVariance + } deriving (Eq, Show, Typeable, Data) + +instance NFData SampleAnalysis where + rnf SampleAnalysis{..} = + rnf anMean `seq` rnf anStdDev `seq` rnf anOutliers `seq` () + +instance ToJSON SampleAnalysis where + toJSON SampleAnalysis{..} = object [ + "mean" .= anMean + , "stdDev" .= anStdDev + , "outliers" .= anOutliers + ] + +instance FromJSON SampleAnalysis where + parseJSON (Object v) = SampleAnalysis <$> + v .: "mean" <*> + v .: "stdDev" <*> + v .: "outliers" + parseJSON _ = empty diff --git a/Criterion/Config.hs b/Criterion/Config.hs --- a/Criterion/Config.hs +++ b/Criterion/Config.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Criterion.Config @@ -24,6 +24,7 @@ ) where import Criterion.MultiMap (MultiMap) +import Data.Data (Data) import Data.Function (on) import Data.Monoid (Monoid(..), Last(..)) import Data.Typeable (Typeable) @@ -39,7 +40,7 @@ | List -- ^ Print a list of known benchmarks. | Version -- ^ Print version information (if known). | Help -- ^ Print a help\/usaage message. - deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable) + deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data) instance Monoid PrintExit where mempty = Nada @@ -52,12 +53,12 @@ | PNG Int Int -- ^ PNG file, dimensions in pixels. | SVG Int Int -- ^ SVG file, dimensions in points. | Window Int Int-- ^ Display in a window, dimensions in pixels. - deriving (Eq, Ord, Read, Show, Typeable) + deriving (Eq, Ord, Read, Show, Typeable, Data) -- | What to plot. data Plot = KernelDensity -- ^ Kernel density estimate of probabilities. | Timing -- ^ Benchmark timings. - deriving (Eq, Ord, Read, Show, Typeable) + deriving (Eq, Ord, Read, Show, Typeable, Data) -- | Top-level program configuration. data Config = Config { diff --git a/Criterion/Measurement.hs b/Criterion/Measurement.hs --- a/Criterion/Measurement.hs +++ b/Criterion/Measurement.hs @@ -40,7 +40,7 @@ return $! end - start getTime :: IO Double -getTime = (fromRational . toRational) `fmap` getPOSIXTime +getTime = realToFrac `fmap` getPOSIXTime runForAtLeast :: Double -> Int -> (Int -> IO a) -> IO (Double, Int, a) runForAtLeast howLong initSeed act = loop initSeed (0::Int) =<< getTime diff --git a/Criterion/MultiMap.hs b/Criterion/MultiMap.hs --- a/Criterion/MultiMap.hs +++ b/Criterion/MultiMap.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} + module Criterion.MultiMap ( MultiMap @@ -7,7 +9,9 @@ , lookup ) where +import Data.Data (Data) import Data.Monoid (Monoid(..)) +import Data.Typeable (Typeable) import Prelude hiding (lookup) import qualified Data.Map as M import qualified Data.Set as S @@ -15,7 +19,7 @@ newtype MultiMap k v = MultiMap { toMap :: M.Map k (S.Set v) } - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Typeable, Data) instance (Ord k, Ord v) => Monoid (MultiMap k v) where mempty = MultiMap M.empty diff --git a/criterion.cabal b/criterion.cabal --- a/criterion.cabal +++ b/criterion.cabal @@ -1,5 +1,5 @@ name: criterion -version: 0.5.0.10 +version: 0.5.1.0 synopsis: Robust, reliable performance measurement and analysis license: BSD3 license-file: LICENSE @@ -13,10 +13,8 @@ cabal-version: >= 1.6 extra-source-files: README.markdown - examples/Fibber.hs - examples/Judy.hs - examples/Makefile - examples/Tiny.hs + examples/*.hs + description: This library provides a powerful but simple way to measure the performance of Haskell code. It provides both a framework for @@ -40,6 +38,7 @@ exposed-modules: Criterion Criterion.Analysis + Criterion.Analysis.Types Criterion.Config Criterion.Environment Criterion.IO @@ -51,6 +50,7 @@ Criterion.Types build-depends: + aeson, base < 5, bytestring >= 0.9 && < 1.0, containers, @@ -59,7 +59,7 @@ mtl, mwc-random >= 0.8.0.3, parsec >= 3.1.0, - statistics >= 0.8.0.5, + statistics >= 0.8.0.6, time, vector >= 0.7.0.0, vector-algorithms >= 0.4 diff --git a/examples/Makefile b/examples/Makefile deleted file mode 100644 --- a/examples/Makefile +++ /dev/null @@ -1,9 +0,0 @@ -all := Fibber Judy Tiny - -all: $(all) - -%: %.hs - ghc -O --make $< - -clean: - -rm -f *.hi *.o $(all)