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