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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
then String -> IO (Stats, Stats)
forall a. HasCallStack => String -> a
error String
"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 a b. (a -> b) -> IO a -> IO b
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
{ min :: Double
min = [Double] -> Double
forall a. HasCallStack => [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. HasCallStack => [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
{ min :: Double
min = [Double] -> Double
forall a. HasCallStack => [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. HasCallStack => [a] -> a
last [Double]
ys
, percentiles :: [(Int, Double)]
percentiles = [Double] -> [(Int, Double)]
percentiles' [Double]
ys
}
(Stats, Stats) -> IO (Stats, Stats)
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 :: forall a. 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 a. a -> IO a
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 a. a -> IO a
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 :: forall a. Int -> [(String, IO a)] -> IO ()
benchMany Int
iters [(String, IO a)]
bms = do
[(Stats, Stats)]
results <- [(String, IO a)]
-> ((String, 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 [(String, IO a)]
bms (((String, IO a) -> IO (Stats, Stats)) -> IO [(Stats, Stats)])
-> ((String, IO a) -> IO (Stats, Stats)) -> IO [(Stats, Stats)]
forall a b. (a -> b) -> a -> b
$ \(String
_, 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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
action)
[(String, Stats)] -> IO ()
printStatsSummaries ([(String, Stats)] -> IO ()) -> [(String, Stats)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> [Stats] -> [(String, Stats)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, IO a) -> String) -> [(String, IO a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, IO a) -> String
forall a b. (a, b) -> a
fst [(String, 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 -> String -> String
[Stats] -> String -> String
Stats -> String
(Int -> Stats -> String -> String)
-> (Stats -> String) -> ([Stats] -> String -> String) -> Show Stats
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Stats -> String -> String
showsPrec :: Int -> Stats -> String -> String
$cshow :: Stats -> String
show :: Stats -> String
$cshowList :: [Stats] -> String -> String
showList :: [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 = ((Int, Double) -> String) -> [(Int, Double)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Double -> String) -> (Int, Double) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Double -> String) -> (Int, Double) -> String)
-> (Int -> Double -> String) -> (Int, Double) -> String
forall a b. (a -> b) -> a -> b
$ String -> Int -> Double -> String
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 ([String] -> String) -> [String] -> String
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
[(String, Stats)] -> ((String, Stats) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Stats)]
rows (((String, Stats) -> IO ()) -> IO ())
-> ((String, Stats) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
label, Stats
stats) ->
Int -> String -> Stats -> IO ()
printSummary Int
colWidth (String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"%-*s" Int
lblLen (String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ")) Stats
stats
where
labels :: [String]
labels = ((String, Stats) -> String) -> [(String, Stats)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Stats) -> String
forall a b. (a, b) -> a
fst [(String, Stats)]
rows
results :: [Stats]
results = ((String, Stats) -> Stats) -> [(String, Stats)] -> [Stats]
forall a b. (a -> b) -> [a] -> [b]
map (String, Stats) -> Stats
forall a b. (a, b) -> b
snd [(String, Stats)]
rows
lblLen :: Int
lblLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
labels) Int -> Int -> Int
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 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.max ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
headers) (Int -> Int) -> ([Stats] -> Int) -> [Stats] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Ord a => [a] -> a
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 a. Ord a => [a] -> a
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 (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (Double -> String) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Double -> String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w = String
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 -> String
forall a. Int -> a -> [a]
replicate (Int
amt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
amt Char
' '
| Bool
otherwise = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
amt Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
amt Char
' '
where
n :: Int
n = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
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
String -> IO ()
putStrLn String
"Times (ms)"
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
lblLen Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String
-> Int
-> Double
-> Int
-> Double
-> Int
-> Double
-> Int
-> Double
-> Int
-> Double
-> String
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 = (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. HasCallStack => [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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs
rank :: a -> a
rank a
p = Double -> a
forall b. Integral b => Double -> b
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 :: forall a. [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