module Test.BenchPress
(
benchmark,
bench,
benchMany,
Stats(..),
printDetailedStats,
printStatsSummaries,
) where
import Control.Exception (bracket)
import Control.Monad (forM, forM_)
import Data.List (intersperse, sort)
import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)
import qualified Math.Statistics as Math
import Prelude hiding (max, min)
import qualified Prelude
import System.CPUTime (getCPUTime)
import Text.Printf (printf)
benchmark :: Int -> IO a -> (a -> IO b) -> (a -> IO c) -> IO (Stats, Stats)
benchmark :: forall a b c.
Int -> IO a -> (a -> IO b) -> (a -> IO c) -> IO (Stats, Stats)
benchmark Int
iters IO a
setup a -> IO b
teardown a -> IO c
action =
if Int
iters forall a. Ord a => a -> a -> Bool
< Int
1
then forall a. HasCallStack => String -> a
error String
"benchmark: iters must be greater than 0"
else do
([Double]
cpuTimes, [Double]
wallTimes) <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall {a}. (Eq a, Num a) => a -> IO [(Double, Double)]
go Int
iters
let xs :: [Double]
xs = forall a. Ord a => [a] -> [a]
sort [Double]
cpuTimes
cpuStats :: Stats
cpuStats = Stats
{ min :: Double
min = forall a. [a] -> a
head [Double]
xs
, mean :: Double
mean = forall a. Floating a => [a] -> a
Math.mean [Double]
xs
, stddev :: Double
stddev = forall a. Floating a => [a] -> a
Math.stddev [Double]
xs
, median :: Double
median = forall a. (Floating a, Ord a) => [a] -> a
Math.median [Double]
xs
, max :: Double
max = forall a. [a] -> a
last [Double]
xs
, percentiles :: [(Int, Double)]
percentiles = [Double] -> [(Int, Double)]
percentiles' [Double]
xs
}
ys :: [Double]
ys = forall a. Ord a => [a] -> [a]
sort [Double]
wallTimes
wallStats :: Stats
wallStats = Stats
{ min :: Double
min = forall a. [a] -> a
head [Double]
ys
, mean :: Double
mean = forall a. Floating a => [a] -> a
Math.mean [Double]
ys
, stddev :: Double
stddev = forall a. Floating a => [a] -> a
Math.stddev [Double]
ys
, median :: Double
median = forall a. (Floating a, Ord a) => [a] -> a
Math.median [Double]
ys
, max :: Double
max = forall a. [a] -> a
last [Double]
ys
, percentiles :: [(Int, Double)]
percentiles = [Double] -> [(Int, Double)]
percentiles' [Double]
ys
}
forall (m :: * -> *) a. Monad m => a -> m a
return (Stats
cpuStats, Stats
wallStats)
where
go :: a -> IO [(Double, Double)]
go a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
go a
n = do
(Double, Double)
elapsed <- forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO a
setup a -> IO b
teardown forall a b. (a -> b) -> a -> b
$ \a
a -> do
UTCTime
startWall <- IO UTCTime
getCurrentTime
Integer
startCpu <- IO Integer
getCPUTime
c
_ <- a -> IO c
action a
a
Integer
endCpu <- IO Integer
getCPUTime
UTCTime
endWall <- IO UTCTime
getCurrentTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Double
picosToMillis forall a b. (a -> b) -> a -> b
$! Integer
endCpu forall a. Num a => a -> a -> a
- Integer
startCpu
,NominalDiffTime -> Double
secsToMillis forall a b. (a -> b) -> a -> b
$! UTCTime
endWall UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
startWall)
[(Double, Double)]
timings <- a -> IO [(Double, Double)]
go forall a b. (a -> b) -> a -> b
$! a
n forall a. Num a => a -> a -> a
- a
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Double, Double)
elapsed forall a. a -> [a] -> [a]
: [(Double, Double)]
timings
bench :: Int -> IO a -> IO ()
bench :: forall a. Int -> IO a -> IO ()
bench Int
iters IO a
action = do
(Stats
stats, Stats
_) <- forall a b c.
Int -> IO a -> (a -> IO b) -> (a -> IO c) -> IO (Stats, Stats)
benchmark Int
iters (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const IO a
action)
Stats -> IO ()
printDetailedStats Stats
stats
benchMany :: Int -> [(String, IO a)] -> IO ()
benchMany :: forall a. Int -> [(String, IO a)] -> IO ()
benchMany Int
iters [(String, IO a)]
bms = do
[(Stats, Stats)]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, IO a)]
bms forall a b. (a -> b) -> a -> b
$ \(String
_, IO a
action) ->
forall a b c.
Int -> IO a -> (a -> IO b) -> (a -> IO c) -> IO (Stats, Stats)
benchmark Int
iters (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const IO a
action)
[(String, Stats)] -> IO ()
printStatsSummaries forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, IO a)]
bms) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Stats, Stats)]
results)
data Stats = Stats
{ Stats -> Double
min :: Double
, Stats -> Double
mean :: Double
, Stats -> Double
stddev :: Double
, Stats -> Double
median :: Double
, Stats -> Double
max :: Double
, Stats -> [(Int, Double)]
percentiles :: [(Int, Double)]
} deriving Int -> Stats -> String -> String
[Stats] -> String -> String
Stats -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Stats] -> String -> String
$cshowList :: [Stats] -> String -> String
show :: Stats -> String
$cshow :: Stats -> String
showsPrec :: Int -> Stats -> String -> String
$cshowsPrec :: Int -> Stats -> String -> String
Show
printDetailedStats :: Stats -> IO ()
printDetailedStats :: Stats -> IO ()
printDetailedStats Stats
stats = do
Int -> Int -> IO ()
printSummaryHeader Int
0 Int
colWidth
Int -> String -> Stats -> IO ()
printSummary Int
colWidth String
"" Stats
stats
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"Percentiles (ms)"
String -> IO ()
putStr String
psTbl
where
columns :: [(Int, Double)] -> [String]
columns = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
" %3d%% %5.3f")
colWidth :: Int
colWidth = [Stats] -> Int
columnWidth [Stats
stats]
psTbl :: String
psTbl = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ [(Int, Double)] -> [String]
columns (Stats -> [(Int, Double)]
percentiles Stats
stats)
printStatsSummaries :: [(String, Stats)] -> IO ()
printStatsSummaries :: [(String, Stats)] -> IO ()
printStatsSummaries [(String, Stats)]
rows = do
Int -> Int -> IO ()
printSummaryHeader Int
lblLen Int
colWidth
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Stats)]
rows forall a b. (a -> b) -> a -> b
$ \(String
label, Stats
stats) ->
Int -> String -> Stats -> IO ()
printSummary Int
colWidth (forall r. PrintfType r => String -> r
printf String
"%-*s" Int
lblLen (String
label forall a. [a] -> [a] -> [a]
++ String
": ")) Stats
stats
where
labels :: [String]
labels = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Stats)]
rows
results :: [Stats]
results = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, Stats)]
rows
lblLen :: Int
lblLen = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
labels) forall a. Num a => a -> a -> a
+ Int
2
colWidth :: Int
colWidth = [Stats] -> Int
columnWidth [Stats]
results
headers :: [String]
= [String
"min", String
"mean", String
"+/-sd", String
"median", String
"max"]
columnWidth :: [Stats] -> Int
columnWidth :: [Stats] -> Int
columnWidth = forall a. Ord a => a -> a -> a
Prelude.max (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
headers) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Stats -> Int
width
where
width :: Stats -> Int
width (Stats Double
min' Double
mean' Double
sd Double
median' Double
max' [(Int, Double)]
_) =
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r. PrintfType r => String -> r
printf String
"%.3f" :: Double -> String))
[Double
min', Double
mean', Double
sd, Double
median', Double
max']
padHeader :: Int -> String -> String
Int
w String
s
| Int
n forall a. Ord a => a -> a -> Bool
> Int
w = String
s
| forall a. Integral a => a -> Bool
odd (Int
w forall a. Num a => a -> a -> a
- Int
n) = forall a. Int -> a -> [a]
replicate (Int
amt forall a. Num a => a -> a -> a
+ Int
1) Char
' ' forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
amt Char
' '
| Bool
otherwise = forall a. Int -> a -> [a]
replicate Int
amt Char
' ' forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
amt Char
' '
where
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
amt :: Int
amt = (Int
w forall a. Num a => a -> a -> a
- Int
n) forall a. Integral a => a -> a -> a
`div` Int
2
printSummaryHeader :: Int -> Int -> IO ()
Int
lblLen Int
colWidth = do
String -> IO ()
putStrLn String
"Times (ms)"
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
lblLen Char
' ' forall a. [a] -> [a] -> [a]
++ String
" "
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
" " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
padHeader Int
colWidth) [String]
headers
printSummary :: Int -> String -> Stats -> IO ()
printSummary :: Int -> String -> Stats -> IO ()
printSummary Int
w String
label (Stats Double
min' Double
mean' Double
sd Double
median' Double
max' [(Int, Double)]
_) =
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s %*.3f %*.3f %*.3f %*.3f %*.3f"
String
label Int
w Double
min' Int
w Double
mean' Int
w Double
sd Int
w Double
median' Int
w Double
max'
percentiles' :: [Double] -> [(Int, Double)]
percentiles' :: [Double] -> [(Int, Double)]
percentiles' [Double]
xs = forall a b. (a -> b) -> [a] -> [b]
map (\Int
p -> (Int
p, [Double]
xs forall a. [a] -> Int -> a
!! forall {a} {a}. (Integral a, Integral a) => a -> a
rank Int
p)) [Int]
ps
where
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs
rank :: a -> a
rank a
p = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Fractional a => a -> a -> a
/ Double
100) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p :: Double) forall a. Num a => a -> a -> a
- a
1
ps :: [Int]
ps = [Int
50, Int
66, Int
75, Int
80, Int
90, Int
95, Int
98, Int
99, Int
100]
picosToMillis :: Integer -> Double
picosToMillis :: Integer -> Double
picosToMillis Integer
t = forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
t forall a. Fractional a => a -> a -> a
/ (Double
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9 :: Int))
secsToMillis :: NominalDiffTime -> Double
secsToMillis :: NominalDiffTime -> Double
secsToMillis NominalDiffTime
t = forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
t forall a. Num a => a -> a -> a
* (Double
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3 :: Int))
intercalate :: [a] -> [[a]] -> [a]
intercalate :: forall a. [a] -> [[a]] -> [a]
intercalate [a]
xs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [a]
xs