{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wall #-}

-- | Statistical choices for multiple performance measurements.
module Perf.Stats
  ( average,
    median,
    tenth,
    averageI,
    averageSecs,
    StatDType (..),
    statD,
    statDs,
    parseStatD,
    -- stat reporting
    addStat,
    ordy,
    allStats,
    statify,
  )
where

import Control.Monad.State.Lazy
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Text (Text, pack)
import NumHask.Space (quantile)
import Options.Applicative

-- | Compute the median
median :: [Double] -> Double
median :: [Double] -> Double
median = Double -> [Double] -> Double
forall (f :: * -> *). Foldable f => Double -> f Double -> Double
quantile Double
0.5

-- | Compute the average
average :: [Double] -> Double
average :: [Double] -> Double
average [Double]
xs = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
xs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> ([Double] -> Int) -> [Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ [Double]
xs)

-- | Compute the tenth percentile
tenth :: [Double] -> Double
tenth :: [Double] -> Double
tenth = Double -> [Double] -> Double
forall (f :: * -> *). Foldable f => Double -> f Double -> Double
quantile Double
0.1

-- | Compute the average of an Integral
averageI :: (Integral a) => [a] -> Double
averageI :: [a] -> Double
averageI [a]
xs = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Double) -> [a] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> ([a] -> Int) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Double) -> [a] -> Double
forall a b. (a -> b) -> a -> b
$ [a]
xs)

-- | Compute the average time in seconds.
averageSecs :: [Double] -> Double
averageSecs :: [Double] -> Double
averageSecs [Double]
xs = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
xs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> ([Double] -> Int) -> [Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ [Double]
xs) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.5e9

-- | Command-line options for type of statistic.
data StatDType = StatAverage | StatMedian | StatBest | StatSecs deriving (StatDType -> StatDType -> Bool
(StatDType -> StatDType -> Bool)
-> (StatDType -> StatDType -> Bool) -> Eq StatDType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatDType -> StatDType -> Bool
$c/= :: StatDType -> StatDType -> Bool
== :: StatDType -> StatDType -> Bool
$c== :: StatDType -> StatDType -> Bool
Eq, Int -> StatDType -> ShowS
[StatDType] -> ShowS
StatDType -> String
(Int -> StatDType -> ShowS)
-> (StatDType -> String)
-> ([StatDType] -> ShowS)
-> Show StatDType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatDType] -> ShowS
$cshowList :: [StatDType] -> ShowS
show :: StatDType -> String
$cshow :: StatDType -> String
showsPrec :: Int -> StatDType -> ShowS
$cshowsPrec :: Int -> StatDType -> ShowS
Show)

-- | Compute a statistic.
statD :: StatDType -> [Double] -> Double
statD :: StatDType -> [Double] -> Double
statD StatDType
StatBest = [Double] -> Double
tenth
statD StatDType
StatMedian = [Double] -> Double
median
statD StatDType
StatAverage = [Double] -> Double
average
statD StatDType
StatSecs = [Double] -> Double
averageSecs

-- | Compute a list of statistics.
statDs :: StatDType -> [[Double]] -> [Double]
statDs :: StatDType -> [[Double]] -> [Double]
statDs StatDType
StatBest = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> Double
tenth ([[Double]] -> [Double])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose
statDs StatDType
StatMedian = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> Double
median ([[Double]] -> [Double])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose
statDs StatDType
StatAverage = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> Double
average ([[Double]] -> [Double])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose
statDs StatDType
StatSecs = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> Double
averageSecs ([[Double]] -> [Double])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose

-- | Parse command-line 'StatDType' options.
parseStatD :: Parser StatDType
parseStatD :: Parser StatDType
parseStatD =
  StatDType -> Mod FlagFields StatDType -> Parser StatDType
forall a. a -> Mod FlagFields a -> Parser a
flag' StatDType
StatBest (String -> Mod FlagFields StatDType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"best" Mod FlagFields StatDType
-> Mod FlagFields StatDType -> Mod FlagFields StatDType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields StatDType
forall (f :: * -> *) a. String -> Mod f a
help String
"report upper decile")
    Parser StatDType -> Parser StatDType -> Parser StatDType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StatDType -> Mod FlagFields StatDType -> Parser StatDType
forall a. a -> Mod FlagFields a -> Parser a
flag' StatDType
StatMedian (String -> Mod FlagFields StatDType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"median" Mod FlagFields StatDType
-> Mod FlagFields StatDType -> Mod FlagFields StatDType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields StatDType
forall (f :: * -> *) a. String -> Mod f a
help String
"report median")
    Parser StatDType -> Parser StatDType -> Parser StatDType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StatDType -> Mod FlagFields StatDType -> Parser StatDType
forall a. a -> Mod FlagFields a -> Parser a
flag' StatDType
StatAverage (String -> Mod FlagFields StatDType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"average" Mod FlagFields StatDType
-> Mod FlagFields StatDType -> Mod FlagFields StatDType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields StatDType
forall (f :: * -> *) a. String -> Mod f a
help String
"report average")
    Parser StatDType -> Parser StatDType -> Parser StatDType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StatDType -> Mod FlagFields StatDType -> Parser StatDType
forall a. a -> Mod FlagFields a -> Parser a
flag' StatDType
StatSecs (String -> Mod FlagFields StatDType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"averagesecs" Mod FlagFields StatDType
-> Mod FlagFields StatDType -> Mod FlagFields StatDType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields StatDType
forall (f :: * -> *) a. String -> Mod f a
help String
"report average in seconds")
    Parser StatDType -> Parser StatDType -> Parser StatDType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StatDType -> Parser StatDType
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatDType
StatAverage

-- | Add a statistic to a State Map
addStat :: (Ord k, Monad m) => k -> s -> StateT (Map.Map k s) m ()
addStat :: k -> s -> StateT (Map k s) m ()
addStat k
label s
s = do
  (Map k s -> Map k s) -> StateT (Map k s) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (k -> s -> Map k s -> Map k s
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
label s
s)

-- | Linguistic conversion of an ordinal
ordy :: Int -> [Text]
ordy :: Int -> [Text]
ordy Int
f = (Int -> Text -> Text) -> [Int] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x Text
s -> (String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Int
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) [Int
1 .. Int
f] ([Text
"st", Text
"nd", Text
"rd"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
"th")

-- | Compute all stats.
allStats :: Int -> Map.Map [Text] [[Double]] -> Map.Map [Text] [Double]
allStats :: Int -> Map [Text] [[Double]] -> Map [Text] [Double]
allStats Int
f Map [Text] [[Double]]
m =
  [([Text], [Double])] -> Map [Text] [Double]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Text], [Double])] -> Map [Text] [Double])
-> [([Text], [Double])] -> Map [Text] [Double]
forall a b. (a -> b) -> a -> b
$
    [[([Text], [Double])]] -> [([Text], [Double])]
forall a. Monoid a => [a] -> a
mconcat
      [ [[([Text], [Double])]] -> [([Text], [Double])]
forall a. Monoid a => [a] -> a
mconcat ((\([Text]
ks, [[Double]]
xss) -> (Text -> [Double] -> ([Text], [Double]))
-> [Text] -> [[Double]] -> [([Text], [Double])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
l [Double]
xs -> ([Text]
ks [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
l], [Double]
xs)) (Int -> [Text]
ordy Int
f) [[Double]]
xss) (([Text], [[Double]]) -> [([Text], [Double])])
-> [([Text], [[Double]])] -> [[([Text], [Double])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Text], [[Double]])]
mlist),
        (\([Text]
ks, [[Double]]
xss) -> ([Text]
ks [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"best"], Double -> [Double] -> Double
forall (f :: * -> *). Foldable f => Double -> f Double -> Double
quantile Double
0.1 ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose [[Double]]
xss)) (([Text], [[Double]]) -> ([Text], [Double]))
-> [([Text], [[Double]])] -> [([Text], [Double])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Text], [[Double]])]
mlist,
        (\([Text]
ks, [[Double]]
xss) -> ([Text]
ks [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"median"], Double -> [Double] -> Double
forall (f :: * -> *). Foldable f => Double -> f Double -> Double
quantile Double
0.5 ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose [[Double]]
xss)) (([Text], [[Double]]) -> ([Text], [Double]))
-> [([Text], [[Double]])] -> [([Text], [Double])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Text], [[Double]])]
mlist,
        (\([Text]
ks, [[Double]]
xss) -> ([Text]
ks [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"average"], [Double] -> Double
forall a (t :: * -> *). (Fractional a, Foldable t) => t a -> a
av ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose [[Double]]
xss)) (([Text], [[Double]]) -> ([Text], [Double]))
-> [([Text], [[Double]])] -> [([Text], [Double])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Text], [[Double]])]
mlist
      ]
  where
    mlist :: [([Text], [[Double]])]
mlist = Map [Text] [[Double]] -> [([Text], [[Double]])]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] [[Double]]
m
    av :: t a -> a
av t a
xs = t a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t a
xs a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (t a -> Int) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
xs)

-- | Convert a Map of performance result to a statistic.
statify :: (Ord a) => StatDType -> Map.Map a [[Double]] -> Map.Map [a] [Double]
statify :: StatDType -> Map a [[Double]] -> Map [a] [Double]
statify StatDType
s Map a [[Double]]
m = ([Double] -> Double) -> [[Double]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StatDType -> [Double] -> Double
statD StatDType
s) ([[Double]] -> [Double])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose ([[Double]] -> [Double]) -> Map [a] [[Double]] -> Map [a] [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> [a]) -> Map a [[Double]] -> Map [a] [[Double]]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []) Map a [[Double]]
m