Commits

Bryan O'Sullivan committed 642eab1

Update to vector package.

Comments (0)

Files changed (12)

 -- |
 -- Module      : Criterion
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 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)
 
 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
   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
                  -> 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)
     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

Criterion/Analysis.hs

 -- |
 -- Module      : Criterion.Analysis
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 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)
 
 -- | 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

Criterion/Config.hs

 
 -- |
 -- Module      : Criterion.Config
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com

Criterion/Environment.hs

 
 -- |
 -- Module      : Criterion.Environment
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 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 {
 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
              }
   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
 -- |
 -- Module      : Criterion.IO
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com

Criterion/Main.hs

 -- |
 -- Module      : Criterion.Main
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com

Criterion/Measurement.hs

 {-# 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
     ) 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
 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

Criterion/Monad.hs

 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -- |
 -- Module      : Criterion.Monad
--- Copyright   : (c) Neil Brown 2009
+-- Copyright   : (c) 2009 Neil Brown
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com

Criterion/Plot.hs

 
 -- |
 -- Module      : Criterion.Plot
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
 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)
 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
 -- | 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

Criterion/Types.hs

 
 -- |
 -- Module      : Criterion.Types
--- Copyright   : (c) Bryan O'Sullivan 2009
+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan
 --
 -- License     : BSD-style
 -- Maintainer  : bos@serpentine.com
-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
 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
   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:
     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
 
   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