Permalink
Browse files

Update to vector package.

--HG--
extra : convert_revision : 6cb9d7121c27ca63edc397907d189a8b25c53b50
  • Loading branch information...
bos committed Mar 29, 2010
1 parent 417ba27 commit af4944b175a1ea4e0d69049dce9c5d1f8c0e0841
Showing with 69 additions and 51 deletions.
  1. +13 −12 Criterion.hs
  2. +3 −3 Criterion/Analysis.hs
  3. +1 −1 Criterion/Config.hs
  4. +11 −11 Criterion/Environment.hs
  5. +1 −1 Criterion/IO.hs
  6. +1 −1 Criterion/Main.hs
  7. +17 −6 Criterion/Measurement.hs
  8. +1 −1 Criterion/Monad.hs
  9. +7 −6 Criterion/Plot.hs
  10. +1 −1 Criterion/Types.hs
  11. +1 −1 LICENSE
  12. +12 −7 criterion.cabal
View
@@ -1,6 +1,6 @@
-- |
-- Module : Criterion
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
@@ -36,14 +36,14 @@ import Criterion.Monad (Criterion, getConfig, getConfigItem)
import Criterion.Plot (plotWith, plotKDE, plotTiming)
import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure,
bench, bgroup, nf, nfIO, whnf, whnfIO)
-import Data.Array.Vector ((:*:)(..), concatU, lengthU, mapU)
-import Statistics.Function (createIO, minMax)
+import qualified Data.Vector.Unboxed as U
+import Statistics.Function (create, minMax)
import Statistics.KernelDensity (epanechnikovPDF)
-import Statistics.RandomVariate (withSystemRandom)
-import Statistics.Resampling (resample)
+import Statistics.Resampling (Resample, resample)
import Statistics.Resampling.Bootstrap (Estimate(..), bootstrapBCA)
import Statistics.Sample (mean, stdDev)
import Statistics.Types (Sample)
+import System.Random.MWC (withSystemRandom)
import System.Mem (performGC)
import Text.Printf (printf)
@@ -53,8 +53,7 @@ runBenchmark :: Benchmarkable b => Environment -> b -> Criterion Sample
runBenchmark env b = do
liftIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)
let minTime = envClockResolution env * 1000
- (testTime :*: testIters :*: _) <-
- liftIO $ runForAtLeast (min minTime 0.1) 1 (run b)
+ (testTime, testIters, _) <- liftIO $ runForAtLeast (min minTime 0.1) 1 (run b)
prolix "ran %d iterations in %s\n" testIters (secs testTime)
cfg <- getConfig
let newIters = ceiling $ minTime * testItersD / testTime
@@ -64,8 +63,8 @@ runBenchmark env b = do
note "collecting %d samples, %d iterations each, in estimated %s\n"
sampleCount newIters (secs (fromIntegral sampleCount * newItersD *
testTime / testItersD))
- times <- liftIO . fmap (mapU ((/ newItersD) . subtract (envClockCost env))) .
- createIO sampleCount . const $ do
+ times <- liftIO . fmap (U.map ((/ newItersD) . subtract (envClockCost env))) .
+ create sampleCount . const $ do
when (fromLJ cfgPerformGC cfg) $ performGC
time_ (run b newIters)
return times
@@ -75,11 +74,12 @@ runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b
-> Criterion Sample
runAndAnalyseOne env _desc b = do
times <- runBenchmark env b
- let numSamples = lengthU times
+ let numSamples = U.length times
let ests = [mean,stdDev]
numResamples <- getConfigItem $ fromLJ cfgResamples
note "bootstrapping with %d resamples\n" numResamples
- res <- liftIO $ withSystemRandom (\gen -> resample gen ests numResamples times)
+ 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)
@@ -114,7 +114,8 @@ plotAll descTimes = forM_ descTimes $ \(desc,times) -> do
extremes = case descTimes of
(_:_:_) -> toJust . minMax . concatU . map snd $ descTimes
_ -> Nothing
- toJust r@(lo :*: hi)
+ concatU = foldr (U.++) U.empty
+ toJust r@(lo, hi)
| lo == infinity || hi == -infinity = Nothing
| otherwise = Just r
where infinity = 1/0
View
@@ -1,6 +1,6 @@
-- |
-- Module : Criterion.Analysis
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
@@ -24,7 +24,7 @@ import Control.Monad (when)
import Criterion.IO (note)
import Criterion.Measurement (secs)
import Criterion.Monad (Criterion)
-import Data.Array.Vector (foldlU)
+import qualified Data.Vector.Unboxed as U
import Data.Int (Int64)
import Data.Monoid (Monoid(..))
import Statistics.Function (sort)
@@ -67,7 +67,7 @@ addOutliers (Outliers s a b c d) (Outliers t w x y z) =
-- | Classify outliers in a data set, using the boxplot technique.
classifyOutliers :: Sample -> Outliers
-classifyOutliers sa = foldlU ((. outlier) . mappend) mempty ssa
+classifyOutliers sa = U.foldl ((. outlier) . mappend) mempty ssa
where outlier e = Outliers {
samplesSeen = 1
, lowSevere = if e <= loS then 1 else 0
View
@@ -2,7 +2,7 @@
-- |
-- Module : Criterion.Config
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
View
@@ -2,7 +2,7 @@
-- |
-- Module : Criterion.Environment
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
@@ -23,9 +23,9 @@ import Criterion.Analysis (analyseMean)
import Criterion.IO (note)
import Criterion.Measurement (getTime, runForAtLeast, time_)
import Criterion.Monad (Criterion)
-import Data.Array.Vector
+import qualified Data.Vector.Unboxed as U
import Data.Typeable (Typeable)
-import Statistics.Function (createIO)
+import Statistics.Function (create)
-- | Measured aspects of the execution environment.
data Environment = Environment {
@@ -39,7 +39,7 @@ data Environment = Environment {
measureEnvironment :: Criterion Environment
measureEnvironment = do
note "warming up\n"
- (_ :*: seed :*: _) <- liftIO $ runForAtLeast 0.1 10000 resolution
+ (_, seed, _) <- liftIO $ runForAtLeast 0.1 10000 resolution
note "estimating clock resolution...\n"
clockRes <- thd3 `fmap` liftIO (runForAtLeast 0.5 seed resolution) >>=
uncurry analyseMean
@@ -51,13 +51,13 @@ measureEnvironment = do
}
where
resolution k = do
- times <- createIO (k+1) (const getTime)
- return (tailU . filterU (>=0) . zipWithU (-) (tailU times) $ times,
- lengthU times)
+ times <- create (k+1) (const getTime)
+ return (U.tail . U.filter (>=0) . U.zipWith (-) (U.tail times) $ times,
+ U.length times)
cost timeLimit = liftIO $ do
let timeClock k = time_ (replicateM_ k getTime)
timeClock 1
- (_ :*: iters :*: elapsed) <- runForAtLeast 0.01 10000 timeClock
- times <- createIO (ceiling (timeLimit / elapsed)) $ \_ -> timeClock iters
- return (mapU (/ fromIntegral iters) times, lengthU times)
- thd3 (_ :*: _:*: c) = c
+ (_, iters, elapsed) <- runForAtLeast 0.01 10000 timeClock
+ times <- create (ceiling (timeLimit / elapsed)) $ \_ -> timeClock iters
+ return (U.map (/ fromIntegral iters) times, U.length times)
+ thd3 (_, _, c) = c
View
@@ -1,6 +1,6 @@
-- |
-- Module : Criterion.IO
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
View
@@ -1,6 +1,6 @@
-- |
-- Module : Criterion.Main
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
View
@@ -1,5 +1,16 @@
{-# LANGUAGE BangPatterns, ScopedTypeVariables, TypeOperators #-}
+-- |
+-- Module : Criterion.Measurement
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
+--
+-- License : BSD-style
+-- Maintainer : bos@serpentine.com
+-- Stability : experimental
+-- Portability : GHC
+--
+-- Benchmark measurement code.
+
module Criterion.Measurement
(
getTime
@@ -10,16 +21,16 @@ module Criterion.Measurement
) where
import Control.Monad (when)
-import Data.Array.Vector ((:*:)(..))
import Data.Time.Clock.POSIX (getPOSIXTime)
import Text.Printf (printf)
-time :: IO a -> IO (Double :*: a)
+time :: IO a -> IO (Double, a)
time act = do
start <- getTime
result <- act
end <- getTime
- return (end - start :*: result)
+ let !delta = end - start
+ return (delta, result)
time_ :: IO a -> IO Double
time_ act = do
@@ -31,17 +42,17 @@ time_ act = do
getTime :: IO Double
getTime = (fromRational . toRational) `fmap` getPOSIXTime
-runForAtLeast :: Double -> Int -> (Int -> IO a) -> IO (Double :*: Int :*: a)
+runForAtLeast :: Double -> Int -> (Int -> IO a) -> IO (Double, Int, a)
runForAtLeast howLong initSeed act = loop initSeed (0::Int) =<< getTime
where
loop !seed !iters initTime = do
now <- getTime
when (now - initTime > howLong * 10) $
fail (printf "took too long to run: seed %d, iters %d" seed iters)
- elapsed :*: result <- time (act seed)
+ (elapsed,result) <- time (act seed)
if elapsed < howLong
then loop (seed * 2) (iters+1) initTime
- else return (elapsed :*: seed :*: result)
+ else return (elapsed, seed, result)
secs :: Double -> String
secs k
View
@@ -1,7 +1,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Module : Criterion.Monad
--- Copyright : (c) Neil Brown 2009
+-- Copyright : (c) 2009 Neil Brown
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
View
@@ -2,7 +2,7 @@
-- |
-- Module : Criterion.Plot
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
@@ -21,11 +21,12 @@ module Criterion.Plot
import Control.Monad.Trans (liftIO)
import Criterion.Config
import Criterion.Monad (Criterion, getConfigItem)
-import Data.Array.Vector
+import qualified Data.Vector.Unboxed as U
import Data.Char (isSpace, toLower)
import Data.Foldable (forM_)
import Data.List (group, intersperse)
import Statistics.KernelDensity (Points, fromPoints)
+import Statistics.Function (indexed)
import Statistics.Types (Sample)
import System.FilePath (pathSeparator)
import System.IO (IOMode(..), Handle, hPutStr, withBinaryFile)
@@ -53,7 +54,7 @@ plotTiming :: PlotOutput -- ^ The kind of output desired.
plotTiming CSV desc times = do
writeTo (mangle $ printf "%s timings.csv" desc) $ \h -> do
putRow h ["sample", "execution time"]
- forM_ (fromU $ indexedU times) $ \(x :*: y) ->
+ forM_ (U.toList $ indexed times) $ \(x,y) ->
putRow h [show x, show y]
#ifdef HAVE_CHART
@@ -80,15 +81,15 @@ plotTiming output _desc _times =
-- | Plot kernel density estimate.
plotKDE :: PlotOutput -- ^ The kind of output desired.
-> String -- ^ Benchmark name.
- -> Maybe (Double :*: Double) -- ^ Range of x-axis
+ -> Maybe (Double, Double) -- ^ Range of x-axis
-> Points -- ^ Points at which KDE was computed.
- -> UArr Double -- ^ Kernel density estimates.
+ -> U.Vector Double -- ^ Kernel density estimates.
-> IO ()
plotKDE CSV desc _exs points pdf = do
writeTo (mangle $ printf "%s densities.csv" desc) $ \h -> do
putRow h ["execution time", "probability"]
- forM_ (zip (fromU pdf) (fromU (fromPoints points))) $ \(x, y) ->
+ forM_ (zip (U.toList pdf) (U.toList (fromPoints points))) $ \(x, y) ->
putRow h [show x, show y]
#ifdef HAVE_CHART
View
@@ -3,7 +3,7 @@
-- |
-- Module : Criterion.Types
--- Copyright : (c) Bryan O'Sullivan 2009
+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
View
@@ -1,4 +1,4 @@
-Copyright (c) 2009, Bryan O'Sullivan
+Copyright (c) 2009, 2010 Bryan O'Sullivan
All rights reserved.
Redistribution and use in source and binary forms, with or without
View
@@ -1,11 +1,11 @@
name: criterion
-version: 0.4.1.0
+version: 0.5.0.0
synopsis: Robust, reliable performance measurement and analysis
license: BSD3
license-file: LICENSE
author: Bryan O'Sullivan <bos@serpentine.com>
maintainer: Bryan O'Sullivan <bos@serpentine.com>
-copyright: 2009 Bryan O'Sullivan
+copyright: 2009-2010 Bryan O'Sullivan
category: Development, Performance, Testing
build-type: Simple
cabal-version: >= 1.2
@@ -26,7 +26,9 @@ description:
examples in the Criterion.Main module.
flag Chart
- Description: enable use of the Chart package
+ description: enable use of the Chart package
+ -- Broken under GHC 6.12 so far.
+ default: False
library
exposed-modules:
@@ -49,16 +51,17 @@ library
deepseq >= 1.1.0.0,
filepath,
mtl,
+ mwc-random >= 0.5.0.0,
parallel,
parsec,
- statistics >= 0.3.5,
+ statistics >= 0.5.1.0,
time,
- uvector >= 0.1.0.5,
- uvector-algorithms >= 0.2
+ vector >= 0.5,
+ vector-algorithms >= 0.3
if flag(chart)
build-depends:
- Chart>=0.12,
+ Chart >= 0.12,
data-accessor
cpp-options: -DHAVE_CHART
@@ -68,3 +71,5 @@ library
ghc-options: -Wall -funbox-strict-fields -O2
if impl(ghc >= 6.8)
ghc-options: -fwarn-tabs
+ if impl(ghc >= 6.12)
+ ghc-options: -fno-warn-unused-do-bind

0 comments on commit af4944b

Please sign in to comment.