From 863d0cdca6dbf04505873b3c10f9dbd134a0d1e9 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Sun, 5 May 2024 21:24:50 +0800 Subject: [PATCH] Add performace diff benchmarks (#4203) * add performance diff `resultDiff.csv` showing the performance different between two version * add resultDiff CI --------- Co-authored-by: Michael Peyton Jones Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- .github/workflows/bench.yml | 3 + bench/Main.hs | 1 + bench/README.md | 3 + .../src/Development/Benchmark/Rules.hs | 120 +++++++++++------- 4 files changed, 82 insertions(+), 45 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 48890b19e..da518feea 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -156,6 +156,9 @@ jobs: - name: Display results run: | column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/results.txt + echo + echo "Performance Diff(comparing to its previous Version):" + column -s, -t < bench-results/unprofiled/${{ matrix.example }}/resultDiff.csv | tee bench-results/unprofiled/${{ matrix.example }}/resultDiff.txt - name: tar benchmarking artifacts run: find bench-results -name "*.csv" -or -name "*.svg" -or -name "*.html" | xargs tar -czf benchmark-artifacts.tar.gz diff --git a/bench/Main.hs b/bench/Main.hs index a832242b2..eec4380eb 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -163,6 +163,7 @@ createBuildSystem config = do buildRules build hlsBuildRules benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchHls warmupHls "haskell-language-server" (parallelism configStatic)) + addGetParentOracle csvRules build svgRules build heapProfileRules build diff --git a/bench/README.md b/bench/README.md index 557fcc142..1dc1e6a3d 100644 --- a/bench/README.md +++ b/bench/README.md @@ -54,6 +54,9 @@ Targets: - bench-results/*/*/*/results.csv - bench-results/*/*/results.csv - bench-results/*/results.csv + - bench-results/*/*/*/resultDiff.csv + - bench-results/*/*/resultDiff.csv + - bench-results/*/resultDiff.csv - bench-results/*/*/*/*.svg - bench-results/*/*/*/*.diff.svg - bench-results/*/*/*.svg diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 9c8675d03..98cfd717d 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -48,6 +48,7 @@ module Development.Benchmark.Rules ( buildRules, MkBuildRules(..), OutputFolder, ProjectRoot, benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..), + addGetParentOracle, csvRules, svgRules, heapProfileRules, @@ -77,11 +78,13 @@ import Data.Aeson (FromJSON (..), import Data.Aeson.Lens (AsJSON (_JSON), _Object, _String) import Data.ByteString.Lazy (ByteString) -import Data.Char (isDigit) -import Data.List (find, isInfixOf, +import Data.Char (isAlpha, isDigit) +import Data.List (find, intercalate, + isInfixOf, + isSuffixOf, stripPrefix, transpose) -import Data.List.Extra (lower) +import Data.List.Extra (lower, splitOn) import Data.Maybe (fromMaybe) import Data.String (fromString) import Data.Text (Text) @@ -144,7 +147,9 @@ allTargetsForExample prof baseFolder ex = do configurations <- askOracle $ GetConfigurations () let buildFolder = baseFolder profilingPath prof return $ - [buildFolder getExampleName ex "results.csv"] + [ + buildFolder getExampleName ex "results.csv" + , buildFolder getExampleName ex "resultDiff.csv"] ++ [ buildFolder getExampleName ex escaped (escapeExperiment e) <.> "svg" | e <- experiments ] @@ -187,6 +192,8 @@ phonyRules prefix executableName prof buildFolder examples = do allTargetsForExample prof buildFolder ex need $ (buildFolder profilingPath prof "results.csv") : concat exampleTargets + need $ (buildFolder profilingPath prof "resultDiff.csv") + : concat exampleTargets phony (prefix <> "all-binaries") $ need =<< allBinaries buildFolder executableName -------------------------------------------------------------------------------- type OutputFolder = FilePath @@ -384,69 +391,92 @@ parseMaxResidencyAndAllocations input = -------------------------------------------------------------------------------- - +-- | oracles to get previous version of a given version +-- used for diff the results +addGetParentOracle :: Rules () +addGetParentOracle = void $ addOracle $ \(GetParent name) -> findPrev name <$> askOracle (GetVersions ()) -- | Rules to aggregate the CSV output of individual experiments csvRules :: forall example . RuleResultForExample example => FilePattern -> Rules () csvRules build = do + let genConfig resultName prefixName prefixOracles out = do + configurations <- prefixOracles + let allResultFiles = [takeDirectory out c resultName | c <- configurations ] + allResults <- traverse readFileLines allResultFiles + let header = head $ head allResults + results = map tail allResults + header' = prefixName <> ", " <> header + results' = zipWith (\v -> map (\l -> v <> ", " <> l)) configurations results + writeFileChanged out $ unlines $ header' : interleave results' -- build results for every experiment*example - build -/- "*/*/*/*/results.csv" %> \out -> do + priority 1 $ build -/- "*/*/*/*/results.csv" %> \out -> do experiments <- askOracle $ GetExperiments () - let allResultFiles = [takeDirectory out escaped (escapeExperiment e) <.> "csv" | e <- experiments] allResults <- traverse readFileLines allResultFiles - let header = head $ head allResults results = map tail allResults writeFileChanged out $ unlines $ header : concat results - + priority 2 $ build -/- "*/*/*/*/resultDiff.csv" %> \out -> do + let out2@[b, flav, example, ver, conf, exp_] = splitDirectories out + prev <- fmap T.unpack $ askOracle $ GetParent $ T.pack ver + allResultsCur <- readFileLines $ joinPath [b ,flav, example, ver, conf] "results.csv" + allResultsPrev <- readFileLines $ joinPath [b ,flav, example, prev, conf] "results.csv" + let resultsPrev = tail allResultsPrev + let resultsCur = tail allResultsCur + let resultDiff = zipWith convertToDiffResults resultsCur resultsPrev + writeFileChanged out $ unlines $ head allResultsCur : resultDiff -- aggregate all configurations for an experiment - build -/- "*/*/*/results.csv" %> \out -> do - configurations <- map confName <$> askOracle (GetConfigurations ()) - let allResultFiles = [takeDirectory out c "results.csv" | c <- configurations ] - - allResults <- traverse readFileLines allResultFiles - - let header = head $ head allResults - results = map tail allResults - header' = "configuration, " <> header - results' = zipWith (\v -> map (\l -> v <> ", " <> l)) configurations results - - writeFileChanged out $ unlines $ header' : interleave results' - + priority 3 $ build -/- "*/*/*/results.csv" %> genConfig "results.csv" + "Configuration" (map confName <$> askOracle (GetConfigurations ())) + priority 3 $ build -/- "*/*/*/resultDiff.csv" %> genConfig "resultDiff.csv" + "Configuration" (map confName <$> askOracle (GetConfigurations ())) -- aggregate all experiments for an example - build -/- "*/*/results.csv" %> \out -> do - versions <- map (T.unpack . humanName) <$> askOracle (GetVersions ()) - let allResultFiles = [takeDirectory out v "results.csv" | v <- versions] - - allResults <- traverse readFileLines allResultFiles - - let header = head $ head allResults - results = map tail allResults - header' = "version, " <> header - results' = zipWith (\v -> map (\l -> v <> ", " <> l)) versions results - - writeFileChanged out $ unlines $ header' : interleave results' - + priority 4 $ build -/- "*/*/results.csv" %> genConfig "results.csv" + "Version" (map (T.unpack . humanName) <$> askOracle (GetVersions ())) + priority 4 $ build -/- "*/*/resultDiff.csv" %> genConfig "resultDiff.csv" + "Version" (map (T.unpack . humanName) <$> askOracle (GetVersions ())) -- aggregate all examples - build -/- "*/results.csv" %> \out -> do - examples <- map (getExampleName @example) <$> askOracle (GetExamples ()) - let allResultFiles = [takeDirectory out e "results.csv" | e <- examples] + priority 5 $ build -/- "*/results.csv" %> genConfig "results.csv" + "Example" (map getExampleName <$> askOracle (GetExamples ())) + priority 5 $ build -/- "*/resultDiff.csv" %> genConfig "resultDiff.csv" + "Example" (map getExampleName <$> askOracle (GetExamples ())) - allResults <- traverse readFileLines allResultFiles +convertToDiffResults :: String -> String -> String +convertToDiffResults line baseLine = intercalate "," diffResults + where items = parseLine line + baseItems = parseLine baseLine + diffItems = zipWith diffItem items baseItems + diffResults = map showItemDiffResult diffItems - let header = head $ head allResults - results = map tail allResults - header' = "example, " <> header - results' = zipWith (\e -> map (\l -> e <> ", " <> l)) examples results +showItemDiffResult :: (Item, Maybe Double) -> String +showItemDiffResult (ItemString x, _) = x +showItemDiffResult (_, Nothing) = "NA" +showItemDiffResult (Mem x, Just y) = printf "%.2f" (y * 100 - 100) <> "%" +showItemDiffResult (Time x, Just y) = printf "%.2f" (y * 100 - 100) <> "%" - writeFileChanged out $ unlines $ header' : concat results' +diffItem :: Item -> Item -> (Item, Maybe Double) +diffItem (Mem x) (Mem y) = (Mem x, Just $ fromIntegral x / fromIntegral y) +diffItem (Time x) (Time y) = (Time x, if y == 0 then Nothing else Just $ x / y) +diffItem (ItemString x) (ItemString y) = (ItemString x, Nothing) +diffItem _ _ = (ItemString "no match", Nothing) + +data Item = Mem Int | Time Double | ItemString String + deriving (Show) + +parseLine :: String -> [Item] +parseLine = map f . splitOn "," + where + f x + | "MB" `isSuffixOf` x = Mem $ read $ reverse $ drop 2 $ reverse x + | otherwise = + case readMaybe @Double x of + Just time -> Time time + Nothing -> ItemString x -------------------------------------------------------------------------------- -- | Rules to produce charts for the GC stats svgRules :: FilePattern -> Rules () svgRules build = do - void $ addOracle $ \(GetParent name) -> findPrev name <$> askOracle (GetVersions ()) -- chart GC stats for an experiment on a given revision priority 1 $ build -/- "*/*/*/*/*.svg" %> \out -> do