Commits

Bryan O'Sullivan  committed 9b73d5e

Some docs.

  • Participants
  • Parent commits c7fcc34

Comments (0)

Files changed (9)

File Criterion.hs

 import Statistics.Types (Sample)
 import System.Mem (performGC)
 
--- | Run a single benchmark and return timings for executing it.
+-- | Run a single benchmark, and return timings measured when
+-- executing it.
 runBenchmark :: Benchmarkable b => Config -> Environment -> b -> IO Sample
 runBenchmark cfg env b = do
   runForAtLeast 0.1 10000 (`replicateM_` getTime)
                    (estConfidenceLevel e)
 
 -- | Run, and analyse, one or more benchmarks.
-runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses which
-                                  -- benchmarks to run by name.
+runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses
+                                  -- whether to run a benchmark by its
+                                  -- name.
               -> Config
               -> Environment
               -> Benchmark

File Criterion/Analysis.hs

+-- |
+-- Module      : Criterion.Analysis
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Analysis code for benchmarks.
+
 module Criterion.Analysis
     (
       Outliers (..)
 import Statistics.Sample (mean)
 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 above the third quartile.
     } deriving (Eq, Read, Show)
 
-data OutlierVariance = Unaffected
-                     | Slight
-                     | Moderate
-                     | Severe
+-- | 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
           iqr = q3 - q1
 {-# INLINE classifyOutliers #-}
 
+-- | 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.
         d     = k * 2 where k = µa - x
         det   = k1 * k1 - 4 * σg2 * k0
 
+-- | Count the total number of outliers in a sample.
 countOutliers :: Outliers -> Int64
 countOutliers (Outliers _ a b c d) = a + b + c + d
 {-# INLINE countOutliers #-}
 
-analyseMean :: Config -> Sample -> Int -> IO Double
+-- | Display the mean of a 'Sample', and characterise the outliers
+-- present in the sample.
+analyseMean :: Config
+            -> Sample
+            -> Int              -- ^ Number of iterations used to
+                                -- compute the sample.
+            -> IO Double
 analyseMean cfg a iters = do
   let µ = mean a
   note cfg "mean is %s (%d iterations)\n" (secs µ) iters
   noteOutliers cfg . classifyOutliers $ a
   return µ
 
+-- | Display a report of the 'Outliers' present in a 'Sample'.
 noteOutliers :: Config -> Outliers -> IO ()
 noteOutliers cfg o = do
   let frac n = (100::Double) * fromIntegral n / fromIntegral (samplesSeen o)

File Criterion/Config.hs

 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
+-- |
+-- Module      : Criterion.Config
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Benchmarking configuration.
+
 module Criterion.Config
     (
       Config(..)
 import Data.Monoid (Monoid(..), Last(..))
 import Data.Typeable (Typeable)
 
+-- | Control the amount of information displayed.
 data Verbosity = Quiet
                | Normal
                | Verbose
-                 deriving (Eq, Ord, Bounded, Enum, Read, Show)
+                 deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable)
 
-data PrintExit = Nada
-               | List
-               | Version
-               | Help
-                 deriving (Eq, Ord, Bounded, Enum, Read, Show)
+-- | Print some information and exit, without running any benchmarks.
+data PrintExit = Nada           -- ^ Do not actually print-and-exit. (Default.)
+               | 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)
 
 instance Monoid PrintExit where
     mempty  = Nada
     mappend = max
 
 -- | Supported plot outputs.  Some outputs support width and height in
--- varying units.
+-- varying units.  A point is 1\/72 of an inch (0.353mm).
 data PlotOutput = CSV           -- ^ Textual CSV file.
                 | PDF Int Int   -- ^ PDF file, dimensions in points.
                 | 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)
+                  deriving (Eq, Ord, Read, Show, Typeable)
 
 -- | What to plot.
-data Plot = KernelDensity
-          | Timing
-            deriving (Eq, Ord, Read, Show)
+data Plot = KernelDensity       -- ^ Kernel density estimate of probabilities.
+          | Timing              -- ^ Benchmark timings.
+            deriving (Eq, Ord, Read, Show, Typeable)
 
+-- | Top-level program configuration.
 data Config = Config {
       cfgBanner       :: Last String -- ^ The \"version\" banner to print.
     , cfgConfInterval :: Last Double -- ^ Confidence interval to use.
     , cfgVerbosity    :: Last Verbosity -- ^ Whether to run verbosely.
     } deriving (Eq, Read, Show, Typeable)
 
-emptyConfig :: Config
-emptyConfig = Config {
-                cfgBanner       = mempty
-              , cfgConfInterval = mempty
-              , cfgPerformGC    = mempty
-              , cfgPlot         = mempty
-              , cfgPrintExit    = mempty
-              , cfgResamples    = mempty
-              , cfgSamples      = mempty
-              , cfgVerbosity    = mempty
-              }
+instance Monoid Config where
+    mempty  = emptyConfig
+    mappend = appendConfig
 
 -- | A configuration with sensible defaults.
 defaultConfig :: Config
                  Last Nothing  -> fromLJ f defaultConfig
                  Last (Just a) -> a
 
+emptyConfig :: Config
+emptyConfig = Config {
+                cfgBanner       = mempty
+              , cfgConfInterval = mempty
+              , cfgPerformGC    = mempty
+              , cfgPlot         = mempty
+              , cfgPrintExit    = mempty
+              , cfgResamples    = mempty
+              , cfgSamples      = mempty
+              , cfgVerbosity    = mempty
+              }
+
 appendConfig :: Config -> Config -> Config
 appendConfig a b =
     Config {
     , cfgVerbosity    = app cfgVerbosity a b
     }
   where app f = mappend `on` f
-
-instance Monoid Config where
-    mempty  = emptyConfig
-    mappend = appendConfig

File Criterion/Environment.hs

-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveDataTypeable, TypeOperators #-}
+
+-- |
+-- Module      : Criterion.Environment
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Code for measuring and characterising the execution environment.
 
 module Criterion.Environment
     (
 import Criterion.IO (note)
 import Criterion.Measurement (getTime, runForAtLeast, time_)
 import Data.Array.Vector
+import Data.Typeable (Typeable)
 import Statistics.Function (createIO)
 
+-- | Measured aspects of the execution environment.
 data Environment = Environment {
       envClockResolution :: {-# UNPACK #-} !Double
+    -- ^ Clock resolution (in seconds).
     , envClockCost       :: {-# UNPACK #-} !Double
-    } deriving (Eq, Read, Show)
+    -- ^ The cost of a single clock call (in seconds).
+    } deriving (Eq, Read, Show, Typeable)
 
+-- | Measure the execution environment.
 measureEnvironment :: Config -> IO Environment
 measureEnvironment cfg = do
   note cfg "warming up\n"
-  seed <- snd3 `fmap` runForAtLeast 0.1 10000 resolution
+  (_ :*: seed :*: _) <- runForAtLeast 0.1 10000 resolution
   note cfg "estimating clock resolution...\n"
   clockRes <- thd3 `fmap` runForAtLeast 0.5 seed resolution >>=
               uncurry (analyseMean cfg)
       (_ :*: iters :*: elapsed) <- runForAtLeast 0.01 10000 timeClock
       times <- createIO (ceiling (timeLimit / elapsed)) $ \_ -> timeClock iters
       return (mapU (/ fromIntegral iters) times, lengthU times)
-
-snd3 :: (a :*: b :*: c) -> b
-snd3 (_ :*: b :*: _) = b
-
-thd3 :: (a :*: b :*: c) -> c
-thd3 (_ :*: _:*: c) = c
+    thd3 (_ :*: _:*: c) = c

File Criterion/IO.hs

+-- |
+-- Module      : Criterion.IO
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Input and output actions.
+
 module Criterion.IO
     (
-      note
+      NoOp
+    , note
     , printError
     , prolix
     ) where
 
 import Criterion.Config (Config, Verbosity(..), cfgVerbosity, fromLJ)
-import System.IO (Handle, IOMode(..), openBinaryFile, stderr, stdout)
-import System.IO.Unsafe (unsafePerformIO)
+import System.IO (stderr, stdout)
 import Text.Printf (HPrintfType, hPrintf)
-import Prelude hiding (error)
 
-nullDev :: Handle
-nullDev = unsafePerformIO $ openBinaryFile "/dev/null" WriteMode
-{-# NOINLINE nullDev #-}
+-- | A typeclass hack to match that of the 'HPrintfType' class.
+class NoOp a where
+    noop :: a
 
-note :: (HPrintfType r) => Config -> String -> r
+instance NoOp (IO a) where
+    noop = return undefined
+
+instance (NoOp r) => NoOp (a -> r) where
+    noop _ = noop
+
+-- | Print a \"normal\" note.
+note :: (HPrintfType r, NoOp r) => Config -> String -> r
 note cfg msg = if fromLJ cfgVerbosity cfg > Quiet
                then hPrintf stdout msg
-               else hPrintf nullDev msg
+               else noop
 
-prolix :: (HPrintfType r) => Config -> String -> r
+-- | Print verbose output.
+prolix :: (HPrintfType r, NoOp r) => Config -> String -> r
 prolix cfg msg = if fromLJ cfgVerbosity cfg == Verbose
                  then hPrintf stdout msg
-                 else hPrintf nullDev msg
+                 else noop
 
+-- | Print an error message.
 printError :: (HPrintfType r) => String -> r
 printError msg = hPrintf stderr msg

File Criterion/Main.hs

+-- |
+-- Module      : Criterion.Main
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Simple @main@ wrappers for benchmarking.
+--
+-- Example:
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+-- > {-# OPTIONS_GHC -fno-full-laziness #-}
+-- >
+-- > import Criterion.Main
+-- >
+-- > fib :: Int -> Int
+-- > fib 0 = 0
+-- > fib 1 = 1
+-- > fib n = fib (n-1) + fib (n-2)
+-- >
+-- > main = defaultMain [
+-- >        bgroup \"fib\" [ bench \"fib 10\" (\(_::Int) -> fib 10)
+-- >                       , bench \"fib 35\" (\(_::Int) -> fib 35)
+-- >                       , bench \"fib 37\" (\(_::Int) -> fib 37)
+-- >                       ]
+-- >                    ]
+
 module Criterion.Main
     (
       Benchmarkable(..)
                | otherwise -> parseError $ q ++ " must be positive"
       _                    -> parseError $ "invalid " ++ q ++ " provided"
 
-parseError :: String -> IO a
-parseError msg = do
-  printError "Error: %s" msg
-  printError "Run \"%s --help\" for usage information\n" =<< getProgName
-  exitWith (ExitFailure 64)
-
 noArg :: Config -> ArgDescr (IO Config)
 noArg = NoArg . return
 
       env <- measureEnvironment cfg
       let shouldRun b = null args || any (`isPrefixOf` b) args
       mapM_ (runAndAnalyse shouldRun cfg env) bs
+
+-- | Display an error message from a command line parsing failure, and
+-- exit.
+parseError :: String -> IO a
+parseError msg = do
+  printError "Error: %s" msg
+  printError "Run \"%s --help\" for usage information\n" =<< getProgName
+  exitWith (ExitFailure 64)

File Criterion/Plot.hs

 {-# LANGUAGE ScopedTypeVariables #-}
 
+-- |
+-- Module      : Criterion.Plot
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Plotting functions.
+
 module Criterion.Plot
     (
       plotKDE
 import Criterion.Config
 import Data.Accessor ((^=))
 import Data.Array.Vector
-import Data.Char (isSpace)
+import Data.Char (isSpace, toLower)
 import Data.Foldable (forM_)
-import Data.List (group)
+import Data.List (group, intersperse)
 import Graphics.Rendering.Chart hiding (Plot,c)
 import Graphics.Rendering.Chart.Gtk (renderableToWindow)
 import Statistics.KernelDensity (Points, fromPoints)
 import Statistics.Types (Sample)
-import System.FilePath (addExtension, pathSeparator)
-import System.IO (IOMode(..), Handle, hPutStr, stdout, withBinaryFile)
+import System.FilePath (pathSeparator)
+import System.IO (IOMode(..), Handle, hPutStr, withBinaryFile)
 import Text.Printf (printf)
 import qualified Criterion.MultiMap as M
 
     Nothing -> return ()
     Just s -> forM_ s $ plot
 
-plotTiming :: PlotOutput -> String -> Sample -> IO ()
+-- | Plot timing data.
+plotTiming :: PlotOutput        -- ^ The kind of output desired.
+           -> String            -- ^ Benchmark name.
+           -> Sample            -- ^ Timing data.
+           -> IO ()
 
 plotTiming CSV desc times = do
-  writeTo (manglePath "csv" (desc ++ " timings")) $ \h -> do
-    putLn h (escapeCSV "sample" ++ ',' : escapeCSV "execution time")
+  writeTo (mangle $ printf "%s timings.csv" desc) $ \h -> do
+    putRow h ["sample", "execution time"]
     forM_ (fromU $ indexedU times) $ \(x :*: y) ->
-      putLn h (show x ++ ',' : show y)
+      putRow h [show x, show y]
 
 plotTiming (PDF x y) desc times =
   renderableToPDFFile (renderTiming desc times) x y
-                      (manglePath "pdf" $ printf "%s timings %dx%d" desc x y)
+                      (mangle $ printf "%s timings %dx%d.pdf" desc x y)
 
 plotTiming (PNG x y) desc times =
   renderableToPNGFile (renderTiming desc times) x y
-                      (manglePath "png" $ printf "%s timings %dx%d" desc x y)
+                      (mangle $ printf "%s timings %dx%d.png" desc x y)
 
 plotTiming (SVG x y) desc times =
   renderableToSVGFile (renderTiming desc times) x y
-                      (manglePath "svg" $ printf "%s timings %dx%d" desc x y)
+                      (mangle $ printf "%s timings %dx%d.svg" desc x y)
 
 plotTiming (Window x y) desc times =
   renderableToWindow (renderTiming desc times) x y
 
-plotKDE :: PlotOutput -> String -> Points -> UArr Double -> IO ()
+-- | Plot kernel density estimate.
+plotKDE :: PlotOutput           -- ^ The kind of output desired.
+        -> String               -- ^ Benchmark name.
+        -> Points               -- ^ Points at which KDE was computed.
+        -> UArr Double          -- ^ Kernel density estimates.
+        -> IO ()
 
 plotKDE CSV desc points pdf = do
-  writeTo (manglePath "csv" (desc ++ " densities")) $ \h -> do
-    putLn h (escapeCSV "execution time" ++ ',' : escapeCSV "probability")
+  writeTo (mangle $ printf "%s densities.csv" desc) $ \h -> do
+    putRow h ["execution time", "probability"]
     forM_ (zip (fromU pdf) (fromU (fromPoints points))) $ \(x, y) ->
-      putLn h (show x ++ ',' : show y)
+      putRow h [show x, show y]
 
 plotKDE (PDF x y) desc points pdf =
   renderableToPDFFile (renderKDE desc points pdf) x y
-                      (manglePath "pdf" $ printf "%s densities %dx%d" desc x y)
+                      (mangle $ printf "%s densities %dx%d.pdf" desc x y)
 
 plotKDE (PNG x y) desc points pdf =
   renderableToPNGFile (renderKDE desc points pdf) x y
-                      (manglePath "png" $ printf "%s densities %dx%d" desc x y)
+                      (mangle $ printf "%s densities %dx%d.png" desc x y)
 
 plotKDE (SVG x y) desc points pdf =
   renderableToSVGFile (renderKDE desc points pdf) x y
-                      (manglePath "svg" $ printf "%s densities %dx%d" desc x y)
+                      (mangle $ printf "%s densities %dx%d.svg" desc x y)
 
 plotKDE (Window x y) desc points pdf =
     renderableToWindow (renderKDE desc points pdf) x y
     info = plot_lines_values ^= [zip (fromU (fromPoints points)) (fromU spdf)]
          $ defaultPlotLines
 
+    -- Normalise the PDF estimates into a semi-sane range.
     spdf = mapU (/ sumU pdf) pdf
 
+-- | An axis whose labels display as seconds (or fractions thereof).
 secAxis :: LinearAxisParams
 secAxis = la_labelf ^= secs
         $ defaultLinearAxis
 
 writeTo :: FilePath -> (Handle -> IO a) -> IO a
-writeTo "-" act  = act stdout
-writeTo path act = withBinaryFile path WriteMode act
+writeTo path = withBinaryFile path WriteMode
 
 escapeCSV :: String -> String
 escapeCSV xs | any (`elem`xs) escapes = '"' : concatMap esc xs ++ "\""
           esc c   = [c]
           escapes = "\"\r\n,"
 
-putLn :: Handle -> String -> IO ()
-putLn h s = hPutStr h (s ++ "\r\n")
+putRow :: Handle -> [String] -> IO ()
+putRow h s = hPutStr h (concat (intersperse "," (map escapeCSV s)) ++ "\r\n")
 
-manglePath :: String -> String -> FilePath
-manglePath _ "-"    = "-"
-manglePath sfx name = (`addExtension` sfx) .
-                      concatMap (replace ((==) '-' . head) "-") .
-                      group .
-                      map (replace isSpace '-') .
-                      map (replace (==pathSeparator) '-') $
-                      name
+-- | Get rid of spaces and other potentially troublesome characters
+-- from output.
+mangle :: String -> FilePath
+mangle = concatMap (replace ((==) '-' . head) "-")
+       . group
+       . map (replace isSpace '-' . replace (==pathSeparator) '-' . toLower)
     where replace p r c | p c       = r
                         | otherwise = c
 
+-- | Try to render meaningful time-axis labels.
+--
+-- /FIXME/: Trouble is, we need to know the range of times for this to
+-- work properly, so that we don't accidentally display consecutive
+-- values that appear identical (e.g. \"43 ms, 43 ms\").
 secs :: Double -> String
 secs k
     | k < 0      = '-' : secs (-k)

File Criterion/Types.hs

 --
 -- For a pure function of type @Int -> a@, the benchmarking harness
 -- calls this function repeatedly, each time with a different 'Int'
--- argument, and reduces the result the function returns to WHNF.
+-- argument, and reduces the result the function returns to weak head
+-- normal form.  If you need the result reduced to normal form, that
+-- is your responsibility.
+--
+-- For an action of type @IO a@, the benchmarking harness calls the
+-- action repeatedly, but does not reduce the result.
 
 {-# LANGUAGE FlexibleInstances, GADTs #-}
 module Criterion.Types
 instance Benchmarkable (IO a) where
     run a _ = a >> return ()
 
--- | A benchmark may be composed of either a single 'Benchmarkable'
--- item with a name, or a (possibly nested) group of 'Benchmark's.
+-- | A benchmark may consist of either a single 'Benchmarkable' item
+-- with a name, created with 'bench', or a (possibly nested) group of
+-- 'Benchmark's, created with 'bgroup'.
 data Benchmark where
     Benchmark  :: Benchmarkable b => String -> b -> Benchmark
     BenchGroup :: String -> [Benchmark] -> Benchmark
 
 -- | Create a single benchmark.
-bench :: Benchmarkable b => String -> b -> Benchmark
+bench :: Benchmarkable b =>
+         String                 -- ^ A name to identify the benchmark.
+      -> b
+      -> Benchmark
 bench = Benchmark
 
 -- | Group several benchmarks together under a common name.
-bgroup :: String -> [Benchmark] -> Benchmark
+bgroup :: String                -- ^ A name to identify the group of benchmarks.
+       -> [Benchmark]           -- ^ Benchmarks to group under this name.
+       -> Benchmark
 bgroup = BenchGroup
 
--- | Retrieve the names of all benchmarks.
+-- | Retrieve the names of all benchmarks.  Grouped benchmarks are
+-- prefixed with the name of the group they're in.
 benchNames :: Benchmark -> [String]
 benchNames (Benchmark d _)   = [d]
 benchNames (BenchGroup d bs) = map ((d ++ "/") ++) . concatMap benchNames $ bs

File criterion.cabal

 name:           criterion
 version:        0.0.1
 synopsis:       Benchmarking
-description:    Benchmarking
 license:        BSD3
 license-file:   LICENSE
 author:         Bryan O'Sullivan <bos@serpentine.com>
 build-type:     Simple
 cabal-version:  >= 1.2
 extra-source-files: README
+description:
+  This library provides a powerful but simple way to measure the
+  performance of Haskell code.
+  .
+  It provides both a framework for executing and analysing benchmarks
+  and a set of simple driver code that makes it easy to build and run
+  them.
 
 library
   exposed-modules: