{-# LANGUAGE PatternGuards, StandaloneDeriving, FlexibleContexts, UndecidableInstances, RankNTypes #-} module BuildBox.Benchmark.BenchResult ( -- * Benchmark results BenchResult (..) , BenchRunResult (..) -- * Concatenation , concatBenchResult -- * Collation , collateBenchResult -- * Statistics , statCollatedBenchResult , statBenchResult -- * Comparison , compareBenchResults , compareBenchResultWith , compareManyBenchResults , predBenchResult , swungBenchResult -- * Merging , mergeBenchResults -- * Advancement , splitBenchResults , advanceBenchResults -- * Application functions , appBenchRunResult , appRunResultAspects -- * Lifting functions , liftBenchRunResult , liftBenchRunResult2 , liftToAspectsOfBenchResult , liftToAspectsOfBenchResult2 , liftRunResultAspects , liftRunResultAspects2) where import BuildBox.Aspect import BuildBox.Quirk import BuildBox.Pretty import Data.List import qualified Data.Set as Set import qualified Data.Map as Map -- BenchResult ------------------------------------------------------------------------------------ -- | We include the name of the original benchmark to it's easy to lookup the results. -- If the `BenchResult` is carrying data derived directly by running a benchmark, -- there will be an element of the `benchResultRuns` for each iteration. On the other hand, -- If the `BenchResult` is carrying statistics or comparison data there should -- be a single element with an index of 0. This is suggested usage, and adhered to by -- the functions in this module, but not required. data BenchResult c = BenchResult { benchResultName :: String , benchResultRuns :: [BenchRunResult c] } deriving instance ( Show (c Seconds), Show (c Bytes)) => Show (BenchResult c) deriving instance ( HasUnits (c Bytes) Bytes , Read (c Bytes) , HasUnits (c Seconds) Seconds , Read (c Seconds)) => Read (BenchResult c) instance ( Pretty (c Seconds), Pretty (c Bytes)) => Pretty (BenchResult c) where ppr result = text (benchResultName result) $+$ nest 4 (vcat $ map ppr $ benchResultRuns result) -- BenchRunResult --------------------------------------------------------------------------------- -- | Holds the result of running a benchmark once. data BenchRunResult c = BenchRunResult { -- | What iteration this run was. -- Use 1 for the first ''real'' iteration derived by running a program. -- Use 0 for ''fake'' iterations computed by statistics or comparisons. benchRunResultIndex :: Integer -- | Information about the run that doesn't carry units, -- eg whether it timed out or segfaulted. , benchRunResultQuirks :: [Quirk] -- | Aspects of the benchmark run that carry units and can have statistics -- extracted from them. , benchRunResultAspects :: [WithUnits (Aspect c)] } deriving instance ( Show (c Seconds), Show (c Bytes)) => Show (BenchRunResult c) deriving instance ( HasUnits (c Bytes) Bytes , Read (c Bytes) , HasUnits (c Seconds) Seconds , Read (c Seconds)) => Read (BenchRunResult c) instance ( Pretty (c Seconds), Pretty (c Bytes)) => Pretty (BenchRunResult c) where ppr result | benchRunResultIndex result == 0 = (nest 2 $ vcat $ map ppr $ benchRunResultAspects result) | otherwise = ppr (benchRunResultIndex result) $$ (nest 2 $ vcat $ map ppr $ benchRunResultAspects result) -- Concat ----------------------------------------------------------------------------------------- -- | Concatenate the results of all runs. -- The the resulting `BenchResult` has a single `BenchRunResult` with an index of 0, containing all aspects. concatBenchResult :: BenchResult c1 -> BenchResult c1 concatBenchResult = liftBenchRunResult $ \bsResults -> [BenchRunResult 0 (concatMap benchRunResultQuirks bsResults) (concatMap benchRunResultAspects bsResults) ] -- | Collate the aspects of each run. See `collateWithUnits` for an explanation and example. collateBenchResult :: BenchResult Single -> BenchResult [] collateBenchResult = liftToAspectsOfBenchResult collateWithUnits -- | Compute statistics from collated aspects of a run. statCollatedBenchResult :: BenchResult [] -> BenchResult Stats statCollatedBenchResult = liftToAspectsOfBenchResult (map (liftWithUnits makeAspectStats)) -- | Collate the aspects, then compute statistics of a run. statBenchResult :: BenchResult Single -> BenchResult Stats statBenchResult = statCollatedBenchResult . collateBenchResult . concatBenchResult -- | Compute comparisons of benchmark results. -- Both results must have the same `benchResultName` else `error`. compareBenchResults :: BenchResult Stats -> BenchResult Stats -> BenchResult StatsComparison compareBenchResults = liftBenchRunResult2 (zipWith (liftRunResultAspects2 (liftsWithUnits2 makeAspectComparisons))) -- | Compute comparisons of benchmark result, looking up the baseline results from a given list. -- If there are no matching baseline results then this creates a `ComparisonNew` in the output. compareBenchResultWith :: [BenchResult Stats] -> BenchResult Stats -> BenchResult StatsComparison compareBenchResultWith base result | Just baseResult <- find (\baseResult -> benchResultName baseResult == benchResultName result) base = compareBenchResults baseResult result | otherwise = liftToAspectsOfBenchResult (liftsWithUnits (map (liftAspect makeStatsComparisonNew))) result -- | Compare some baseline results against new results. -- If there are no matching baseline results then this creates a `ComparisonNew` in the output. compareManyBenchResults :: [BenchResult Stats] -> [BenchResult Stats] -> [BenchResult StatsComparison] compareManyBenchResults base new = map (compareBenchResultWith base) new -- | Return true if any of the aspect data in a result matches a given predicate. predBenchResult :: (forall units. Real units => c units -> Bool) -> BenchResult c -> Bool predBenchResult f = appBenchRunResult $ or . map (appRunResultAspects $ or . map (appAspectWithUnits f)) -- | Return true if any of the aspects have swung by more than a given fraction since last time. -- For example, use @0.1@ for 10 percent. swungBenchResult :: Double -> BenchResult StatsComparison -> Bool swungBenchResult limit = predBenchResult (predSwingStatsComparison (\x -> abs x > limit)) -- Merging ---------------------------------------------------------------------------------------- -- | Merge lists of `BenchResult`s, preferring results from earlier lists. -- In the output list there is one result for every named benchmark in the input. mergeBenchResults :: [[BenchResult c]] -> [BenchResult c] mergeBenchResults resultss = let -- All the available benchResults from all files. results = concat resultss -- Get a the names of all the available benchmarks. names = sort $ nub $ map benchResultName results -- Merge all the results Just newBenchResults = sequence $ [ find (\br -> benchResultName br == name) results | name <- names] in newBenchResults -- Advancement ----------------------------------------------------------------------------------- -- | Given a fraction (like 0.1 for 10 percent), split some results into three -- groups: ''winners'', ''losers'' and ''others''. -- The losers are benchmarks had any aspect increase by more than the fraction. -- Winners are non-losers, where any aspect decreased by the fraction. -- Others are not winners or losers. -- splitBenchResults :: Double -> [BenchResult StatsComparison] -> ([BenchResult StatsComparison], [BenchResult StatsComparison], [BenchResult StatsComparison]) splitBenchResults swing comparisons = let resultLosers = filter (predBenchResult (predSwingStatsComparison (\x -> x > swing))) comparisons resultWinners_ = filter (predBenchResult (predSwingStatsComparison (\x -> x < (- swing)))) comparisons -- losers can't be winners sameName r1 r2 = benchResultName r1 == benchResultName r2 resultWinners = deleteFirstsBy sameName resultWinners_ resultLosers -- others aren't either winners or losers resultOthers = deleteFirstsBy sameName (deleteFirstsBy sameName comparisons resultLosers) resultWinners in (resultWinners, resultLosers, resultOthers) -- | Create a new baseline from original baseline, and recent results. -- If any of the recent results are winners then use them, otherwise use results -- from the old baseline. advanceBenchResults :: Double -> [BenchResult StatsComparison] -- ^ Comparisons to guide the advancement. -> [BenchResult Single] -- ^ Baseline results. -> [BenchResult Single] -- ^ Recent results. -> [BenchResult Single] -- ^ New baseline. advanceBenchResults swing comparisons baselines recents = let allNames = map benchResultName (baselines ++ recents) rsBaseline = Map.fromList [ (benchResultName r, r) | r <- baselines] rsRecent = Map.fromList [ (benchResultName r, r) | r <- recents] rsAll = Map.union rsBaseline rsRecent -- Do the comparison, note that we only get a comparison back -- if the benchmark was in both the original lists. (winners, losers, others) = splitBenchResults swing comparisons nsWinners = Set.fromList $ map benchResultName winners nsLosers = Set.fromList $ map benchResultName losers nsOthers = Set.fromList $ map benchResultName others getResult name | Set.member name nsWinners = let Just r = Map.lookup name rsRecent in r | Set.member name nsLosers || Set.member name nsOthers = let Just r = Map.lookup name rsBaseline in r -- benchmark wasn't in both input lists, so we have no comparison. -- just find the data and pass it through | otherwise = let Just r = Map.lookup name rsAll in r in map getResult allNames -- Lifting ---------------------------------------------------------------------------------------- -- | Apply a function to the aspects of a `BenchRunResult` appBenchRunResult :: ([BenchRunResult c1] -> b) -> BenchResult c1 -> b appBenchRunResult f (BenchResult _ runs) = f runs -- | Lift a function to the `BenchRunResult` in a `BenchResult` liftBenchRunResult :: ([BenchRunResult c1] -> [BenchRunResult c2]) -> (BenchResult c1 -> BenchResult c2) liftBenchRunResult f (BenchResult name runs) = BenchResult name (f runs) -- | Lift a binary function to the `BenchResults` in a `BenchResult` liftBenchRunResult2 :: ([BenchRunResult c1] -> [BenchRunResult c2] -> [BenchRunResult c3]) -> BenchResult c1 -> BenchResult c2 -> BenchResult c3 liftBenchRunResult2 f (BenchResult name1 runs1) (BenchResult name2 runs2) | name1 == name2 = BenchResult name1 (f runs1 runs2) | otherwise = error "liftBenchRunResult2: names don't match" -- | Lift a function to the aspects of each `BenchRunResult`. liftToAspectsOfBenchResult :: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)]) -> BenchResult c1 -> BenchResult c2 liftToAspectsOfBenchResult = liftBenchRunResult . map . liftRunResultAspects -- | Lift a binary function to the aspects of each `BenchRunResult`. liftToAspectsOfBenchResult2 :: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)] -> [WithUnits (Aspect c3)]) -> BenchResult c1 -> BenchResult c2 -> BenchResult c3 liftToAspectsOfBenchResult2 = liftBenchRunResult2 . zipWith . liftRunResultAspects2 -- Lifting ---------------------------------------------------------------------------------------- -- | Apply a function to the aspects of a `BenchRunResult` appRunResultAspects :: ([WithUnits (Aspect c1)] -> b) -> BenchRunResult c1 -> b appRunResultAspects f (BenchRunResult _ _ aspects) = f aspects -- | Lift a function to the aspects of a `BenchRunResult` liftRunResultAspects :: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)]) -> BenchRunResult c1 -> BenchRunResult c2 liftRunResultAspects f (BenchRunResult ix quirks as) = BenchRunResult ix quirks (f as) -- | Lift a binary function to the aspects of two `BenchRunResult`s. -- The resulting `BenchRunResult` gets all the quirks from both. liftRunResultAspects2 :: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)] -> [WithUnits (Aspect c3)]) -> BenchRunResult c1 -> BenchRunResult c2 -> BenchRunResult c3 liftRunResultAspects2 f (BenchRunResult ix1 quirks1 as) (BenchRunResult ix2 quirks2 bs) | ix1 == ix2 = BenchRunResult ix1 (quirks1 ++ quirks2) (f as bs) | otherwise = error "liftRunResultAspects2: indices don't match"