From 04d68db1f690587af5a3c0f1c7f4e33905a8f44d Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 2 May 2024 17:48:19 +0800 Subject: [PATCH 01/10] add performance diff `resultDiff.csv` showing the performance different between two version --- bench/Main.hs | 1 + bench/README.md | 3 + .../src/Development/Benchmark/Rules.hs | 117 +++++++++++------- 3 files changed, 75 insertions(+), 46 deletions(-) diff --git a/bench/Main.hs b/bench/Main.hs index a832242b2b..c869b5f432 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)) + addGeParentOracle csvRules build svgRules build heapProfileRules build diff --git a/bench/README.md b/bench/README.md index 557fcc1420..1dc1e6a3d4 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 9c8675d03c..5846573dd2 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(..), + addGeParentOracle, 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) @@ -187,6 +190,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 +389,89 @@ parseMaxResidencyAndAllocations input = -------------------------------------------------------------------------------- - +addGeParentOracle = 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 $ show out2 : 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] - - allResults <- traverse readFileLines allResultFiles - - let header = head $ head allResults - results = map tail allResults - header' = "example, " <> header - results' = zipWith (\e -> map (\l -> e <> ", " <> l)) examples results + 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 ())) + +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 + +showItemDiffResult :: (Item, Maybe Double) -> String +showItemDiffResult (ItemString x, _) = x +showItemDiffResult (_, Nothing) = "Nah" +showItemDiffResult (Mem x, Just y) = printf "%.2f" (y * 100 - 100) <> "%" +showItemDiffResult (Time x, Just y) = printf "%.2f" (y * 100 - 100) <> "%" + +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) - writeFileChanged out $ unlines $ header' : concat results' +-- split on ',' +parseLine :: String -> [Item] +parseLine = map f . splitOn "," + where + f x + | "MB" `isSuffixOf` x = Mem $ read $ reverse $ drop 2 $ reverse x + -- is is double + | any isAlpha x = ItemString x + | otherwise = Time $ read 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 From 7fab3f3191fca317d07133adaf076dc8d2796397 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 2 May 2024 17:49:32 +0800 Subject: [PATCH 02/10] add resultDiff CI --- .github/workflows/bench.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 48890b19e6..9a95ad78d4 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -156,6 +156,7 @@ jobs: - name: Display results run: | column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/results.txt + column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.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 From bf8f00f4ac7b83919b9056fcde782ee22acc2c5a Mon Sep 17 00:00:00 2001 From: soulomoon Date: Thu, 2 May 2024 19:33:56 +0800 Subject: [PATCH 03/10] Update bench.yml --- .github/workflows/bench.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 9a95ad78d4..bd485a7bc3 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -156,7 +156,7 @@ jobs: - name: Display results run: | column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/results.txt - column -s, -t < bench-results/unprofiled/${{ matrix.example }}/results.csv | tee bench-results/unprofiled/${{ matrix.example }}/resultDiff.txt + 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 From 5476e1a8a158ae2c6b8d115c7ee28d750bc7162f Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 2 May 2024 20:20:50 +0800 Subject: [PATCH 04/10] fix bench header --- shake-bench/src/Development/Benchmark/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 5846573dd2..9cc6844020 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -418,7 +418,7 @@ csvRules build = do let resultsPrev = tail allResultsPrev let resultsCur = tail allResultsCur let resultDiff = zipWith convertToDiffResults resultsCur resultsPrev - writeFileChanged out $ unlines $ show out2 : head allResultsCur : resultDiff + writeFileChanged out $ unlines $ head allResultsCur : resultDiff -- aggregate all configurations for an experiment priority 3 $ build -/- "*/*/*/results.csv" %> genConfig "results.csv" "Configuration" (map confName <$> askOracle (GetConfigurations ())) From 0783b7e852208f169e81677fd9e50aa4507c4daf Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 2 May 2024 21:35:30 +0800 Subject: [PATCH 05/10] add resultDiff in allTargetsForExample --- shake-bench/src/Development/Benchmark/Rules.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 9cc6844020..24461be028 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -147,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 ] From 4414cd2698b6d65abab4912bc5b288740b3c165a Mon Sep 17 00:00:00 2001 From: soulomoon Date: Sun, 5 May 2024 00:34:13 +0800 Subject: [PATCH 06/10] Update shake-bench/src/Development/Benchmark/Rules.hs Co-authored-by: Michael Peyton Jones --- shake-bench/src/Development/Benchmark/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 24461be028..f950f240ee 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -391,7 +391,7 @@ parseMaxResidencyAndAllocations input = -------------------------------------------------------------------------------- -addGeParentOracle = void $ addOracle $ \(GetParent name) -> findPrev name <$> askOracle (GetVersions ()) +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 From d9e2f919c676330358ce2bf7e9781d16fe155255 Mon Sep 17 00:00:00 2001 From: soulomoon Date: Sun, 5 May 2024 00:34:39 +0800 Subject: [PATCH 07/10] Update shake-bench/src/Development/Benchmark/Rules.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- shake-bench/src/Development/Benchmark/Rules.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index f950f240ee..2408e221a3 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -459,7 +459,6 @@ diffItem _ _ = (ItemString "no match", Nothing) data Item = Mem Int | Time Double | ItemString String deriving (Show) --- split on ',' parseLine :: String -> [Item] parseLine = map f . splitOn "," where From 9c6ea862b30ec751a6278499281db4923ff067ef Mon Sep 17 00:00:00 2001 From: soulomoon Date: Sun, 5 May 2024 00:34:57 +0800 Subject: [PATCH 08/10] Update shake-bench/src/Development/Benchmark/Rules.hs Co-authored-by: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> --- shake-bench/src/Development/Benchmark/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 2408e221a3..8c4321304a 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -464,7 +464,7 @@ parseLine = map f . splitOn "," where f x | "MB" `isSuffixOf` x = Mem $ read $ reverse $ drop 2 $ reverse x - -- is is double + -- is it double | any isAlpha x = ItemString x | otherwise = Time $ read x From be0d3a7140f52a934402378c43e6360ea01430ef Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 5 May 2024 00:42:11 +0800 Subject: [PATCH 09/10] clean up --- bench/Main.hs | 2 +- shake-bench/src/Development/Benchmark/Rules.hs | 14 +++++++++----- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/bench/Main.hs b/bench/Main.hs index c869b5f432..eec4380eb4 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -163,7 +163,7 @@ createBuildSystem config = do buildRules build hlsBuildRules benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchHls warmupHls "haskell-language-server" (parallelism configStatic)) - addGeParentOracle + addGetParentOracle csvRules build svgRules build heapProfileRules build diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 8c4321304a..98cfd717d2 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -48,7 +48,7 @@ module Development.Benchmark.Rules ( buildRules, MkBuildRules(..), OutputFolder, ProjectRoot, benchRules, MkBenchRules(..), BenchProject(..), ProfilingMode(..), - addGeParentOracle, + addGetParentOracle, csvRules, svgRules, heapProfileRules, @@ -391,6 +391,9 @@ 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 () @@ -446,7 +449,7 @@ convertToDiffResults line baseLine = intercalate "," diffResults showItemDiffResult :: (Item, Maybe Double) -> String showItemDiffResult (ItemString x, _) = x -showItemDiffResult (_, Nothing) = "Nah" +showItemDiffResult (_, Nothing) = "NA" showItemDiffResult (Mem x, Just y) = printf "%.2f" (y * 100 - 100) <> "%" showItemDiffResult (Time x, Just y) = printf "%.2f" (y * 100 - 100) <> "%" @@ -464,9 +467,10 @@ parseLine = map f . splitOn "," where f x | "MB" `isSuffixOf` x = Mem $ read $ reverse $ drop 2 $ reverse x - -- is it double - | any isAlpha x = ItemString x - | otherwise = Time $ read x + | otherwise = + case readMaybe @Double x of + Just time -> Time time + Nothing -> ItemString x -------------------------------------------------------------------------------- From f7f71a0abbfc8ab8c7e985fc97145ab7d0b59dba Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 5 May 2024 00:44:59 +0800 Subject: [PATCH 10/10] add more information about bench diff result --- .github/workflows/bench.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index bd485a7bc3..da518feeaf 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -156,6 +156,8 @@ 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