diff --git a/examples/examples.hs b/examples/examples.hs --- a/examples/examples.hs +++ b/examples/examples.hs @@ -13,12 +13,12 @@ module Main where -import Data.Scientific +import Readme.Lhs import Formatting import Options.Generic import Perf import Perf.Analysis -import Protolude hiding ((%)) +import Protolude import qualified Data.Map as Map import qualified Data.Text as Text import qualified Data.Vector as V @@ -63,15 +63,6 @@ let !n = fromMaybe 1000 (runs o) let !a = fromMaybe 1000 (sumTo o) let !as = [1, 10, 100, 1000 :: Int] - - writeFile "other/run.md" $ - code - [ formatInt "number of runs:" 2 n - , formatInt "accumulate to:" 2 a - , sformat ((right 24 ' ' %. stext)%stext) "function:" "foldl' (+) 0" - ] - - -- | tick_ testing prewarmup <- tick_ _ <- warmup 100 onetick <- tick_ @@ -83,20 +74,34 @@ let tick99999 = percentile 0.99999 manyticks let tick99 = percentile 0.99 manyticks let tick40 = percentile 0.4 manyticks - writeFile "other/tick_.md" $ - code - [ "pre warmup: " <> show prewarmup <> " cycles" - , "one tick_: " <> show onetick <> " cycles" - , "next 10: " <> show ticks' - , "average over 1m: " <> sformat (fixed 2) avticks <> " cycles" - , "99.999% perc: " <> sformat commas (floor tick99999 :: Integer) - , "99.9% perc: " <> sformat (fixed 2) tick999 - , "99th perc: " <> sformat (fixed 2) tick99 - , "40th perc: " <> sformat (fixed 2) tick40 - , "[min, 20th, .. 80th, max]:" - , mconcat (sformat (" " % prec 4) . fromFloatDigits <$> qticks) - ] + -- perf basics + (result, cs) <- runPerfT $ + perf "sum" cycles (pure $ foldl' (+) 0 [0 .. a]) + putStrLn (show (result, cs) :: Text) + + -- PerfT example + -- prior to Perfification + result <- do + txt <- readFile "perf-analysis/examples/examples.hs" + let n = Text.length txt + let x = foldl' (+) 0 [1..n] + putStrLn $ "sum of one to number of characters is: " <> + (show x :: Text) + pure (n, x) + + -- post-Perfification + (result', ms) <- runPerfT $ do + txt <- perf "file read" cycles $ readFile "perf-analysis/examples/examples.hs" + n <- perf "length" cycles $ pure (Text.length txt) + x <- perf "sum" cycles $ pure (foldl' (+) 0 [1..n]) + perf "print to screen" cycles $ + putStrLn $ "sum of one to number of characters is: " <> + (show x :: Text) + pure (n, x) + + when (result == result') $ print "PerfT has no effect on original computation" + -- | tick tests (t, resultPrime) <- tick fMono a print resultPrime @@ -111,20 +116,6 @@ t10io <- sequence $ replicate 10 (tickIO $ pure (fMono a)) -- t10n <- sequence $ replicate 10 (tickNoinline fMono a) t10' <- sequence $ replicate 10 (tick fMono a) - writeFile "other/tick.md" $ - code - [ "sum to " <> show a - , "first measure: " <> show t <> " cycles" - , "second measure: " <> show t2 <> " cycles" - , "third measure: " <> show t3 <> " cycles" - , "tick': " <> show t' <> " cycles" - , "tickIO: " <> show tio <> " cycles" - -- , "tickNoinline: " <> show tn <> " cycles" - , "tick * 10: " <> show (fst <$> t10) - , "tickIO * 10: " <> show (fst <$> t10io) - -- , "tickNoinline * 10: " <> show (fst <$> t10n) - , "tick * 10: " <> show (fst <$> t10') - ] -- | ticks and ticksIO (rpure, _) <- ticks n fMono a @@ -134,35 +125,14 @@ (rioPoly, _) <- ticksIO n (pure $ fPoly a) (rioLambda, _) <- ticksIO n (pure $ fLambda a) - writeFile "other/ticks.md" $ - code [ "acc = " <> show a <> " n = " <> show n - , formatRunHeader - , formatRun "monomorphic" 2 $ rpure - , formatRun "includes lambda" 2 $ rpureLambda - , formatRun "polymorphic" 2 $ rpurePoly - , formatRun "ticksIO mono" 2 $ rio - , formatRun "ticksIO lambda" 2 $ rioLambda - , formatRun "ticksIO poly" 2 $ rioPoly - ] - - gaps <- sequence $ (\a -> formatGap a <$> tickIO (ticks n fPoly a)) <$> as - writeFile "other/ticksCost.md" $ code gaps + -- | gaps + gaps <- sequence $ (tickIO . ticks n fPoly) <$> as -- | ns testing css <- fmap (fmap fst) <$> sequence ((replicateM n . tick fMono) <$> as) - let r12 = - "(replicateM n . tick fMono) <$> as: " <> - mconcat (sformat (" " %prec 3) <$> - (fromFloatDigits . percentile 0.4 <$> css)) (ts, _) <- ns (ticks n fMono) as - let r13 = - "ns (ticks n fMono) as: " <> - mconcat (sformat (" " %prec 3) <$> - (fromFloatDigits . percentile 0.4 <$> ts)) - writeFile "other/tickns.md" $ - code ["sum to's " <> show as, r13, r12] -- | vectors let asl :: [Int] @@ -185,14 +155,6 @@ let asu :: U.Vector Int = U.generate a identity (runboxed, _) <- ticks n sumu asu - writeFile "other/vector.md" $ - code - [ "sum to " <> show a - , formatRun "ticks list" 2 $ rlist - , formatRun "ticks boxed" 2 $ rboxed - , formatRun "ticks storable" 2 $ rstorable - , formatRun "ticks unboxed" 2 $ runboxed - ] -- WHNF (rnf, _) <- tick (fmap fMono) (Just a) @@ -204,47 +166,101 @@ (rnfsio, _) <- ticksIO n (pure $ fmap fMono (Just a)) (rwhnfsio, _) <- ticksWHNFIO n (pure $ fmap fMono (Just a)) - writeFile "other/whnf.md" $ code - [ "sum to " <> show a - , formatInt "tick" 2 $ rnf - , formatInt "tickWHNF" 2 $ rwhnf - , formatRun "ticks" 2 rnfs - , formatRun "ticksWHNF" 2 rwhnfs - , formatInt "tickIO" 2 rnfio - , formatInt "tickWHNFIO" 2 rwhnfio - , formatRun "ticksIO" 2 rnfsio - , formatRun "ticksWHNFIO" 2 rwhnfsio - ] + void $ runOutput + ("other/readme_.md", GitHubMarkdown) + ("readme.md", GitHubMarkdown) $ do - -- perf basics - (result, cs) <- runPerfT $ - perf "sum" cycles (pure $ foldl' (+) 0 [0 .. a]) - putStrLn (show (result, cs) :: Text) + output "run" $ Native $ (:[]) $ table + "run details" + [] + [AlignLeft, AlignRight] + [0, 0] + [ ["number of runs", formatI 2 n] + , ["accumulate to", formatI 2 a] + , ["function", "foldl' (+) 0"] + ] - -- PerfT example - -- prior to Perfification - result <- do - txt <- readFile "perf-analysis/examples/examples.hs" - let n = Text.length txt - let x = foldl' (+) 0 [1..n] - putStrLn $ "sum of one to number of characters is: " <> - (show x :: Text) - pure (n, x) + output "tick_" $ Native $ (:[]) $ table mempty ["stat", "cycles"] mempty mempty + [ ["pre warmup", show prewarmup] + , ["one tick_", show onetick] + , ["next 10", show ticks'] + , ["average over one million", sformat (fixed 2) avticks] + , ["99.999% perc", sformat commas (floor tick99999 :: Integer)] + , ["99.9% perc", sformat (fixed 2) tick999] + , ["99th perc", sformat (fixed 2) tick99] + , ["40th perc", sformat (fixed 2) tick40] + , ["[min, 20th, .. 80th, max]", + Text.intercalate " " (formatF 4 <$> qticks)] + ] - -- post-Perfification - (result', ms) <- runPerfT $ do - txt <- perf "file read" cycles $ readFile "perf-analysis/examples/examples.hs" - n <- perf "length" cycles $ pure (Text.length txt) - x <- perf "sum" cycles $ pure (foldl' (+) 0 [1..n]) - perf "print to screen" cycles $ - putStrLn $ "sum of one to number of characters is: " <> - (show x :: Text) - pure (n, x) + output "tick" $ Native + [ plain ("sum to " <> show a) + , table mempty ["stat", "cycles"] mempty mempty + [ ["first measure", show t] + , ["second measure", show t2] + , ["third measure", show t3] + , ["tick'", show t'] + , ["tickIO", show tio] + , ["tick * 10", show (fst <$> t10)] + , ["tickIO * 10", show (fst <$> t10io)] + , ["tick' * 10", show (fst <$> t10')] + ] + ] - when (result == result') $ print "PerfT has no effect on original computation" + output "ticks" $ Native [formatRuns 3 2 + [ ("monomorphic", rpure) + , ("includes lambda", rpureLambda) + , ("polymorphic", rpurePoly) + , ("ticksIO mono", rio) + , ("ticksIO lambda", rioLambda) + , ("ticksIO poly", rioPoly) + ]] - let fmt = sformat ((right 40 ' ' %. stext) %prec 3 % " " % stext) - writeFile "other/perf.md" $ - "\nperf cycle measurements\n---\n" <> - code ((\(t,c) -> fmt t (int2Sci c) "cycles") <$> Map.toList ms) + + output "gaps" $ Native $ (:[]) $ table mempty + ["number runs", "outside cycles", "inside cycles", "gap"] + mempty mempty + (zipWith (\a (co, (ci, _)) -> + [ formatI 1 a + , formatI 3 co + , formatI 3 (sum ci) + , formatI 3 (co - sum ci) + ]) as gaps) + + output "tickns" $ Native + [ table mempty (["sum to:"] <> (show <$> as)) mempty mempty + [ ["(replicateM n . tick fMono) <$> as"] <> + (formatF 3 . percentile 0.5 <$> css) + , ["ns (ticks n fMono) as"] <> + (formatF 3 . percentile 0.5 <$> ts) + ] + ] + + output "vector" $ Native $ [plain ("sum to " <> show a)] <> + [formatRuns 3 2 + [ ("ticks list", rlist) + , ("ticks boxed", rboxed) + , ("ticks storable", rstorable) + , ("ticks unboxed", runboxed) + ]] + + output "whnf" $ Native + [ plain ("sum to " <> show a) + , table mempty ["function", "cycles"] mempty mempty + [ ["tick", formatI 3 rnf] + , ["tickWHNF", formatI 3 rwhnf] + , formatRun "ticks" 3 3 rnfs + , formatRun "ticksWHNF" 3 3 rwhnfs + , ["tickIO", formatI 3 rnfio] + , ["tickWHNFIO", formatI 3 rwhnfio] + , formatRun "ticksIO" 3 3 rnfsio + , formatRun "ticksWHNFIO" 3 3 rwhnfsio + ] + ] + + output "perf" $ Native + [ plain "perf cycle measurements" + , table mempty ["effect", "cycles"] mempty mempty + ((\(t,c) -> [t, formatI 3 c]) <$> Map.toList ms) + ] diff --git a/perf-analysis.cabal b/perf-analysis.cabal --- a/perf-analysis.cabal +++ b/perf-analysis.cabal @@ -1,11 +1,5 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. --- --- see: https://github.com/sol/hpack --- --- hash: 5b2bb96e01227ec3ddd4c29e4bebf5895c909acff05541ea597f16b063ce3eb4 - name: perf-analysis -version: 0.0.1.1 +version: 0.1.0.0 synopsis: analysis example using perf description: Analytical tools to use with perf. category: performance @@ -17,9 +11,7 @@ license: BSD3 license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 -extra-source-files: - stack.yaml +cabal-version: 2.0 source-repository head type: git @@ -29,12 +21,10 @@ library exposed-modules: Perf.Analysis - other-modules: - Paths_perf_analysis hs-source-dirs: src build-depends: - base >=4.7 && <4.12 + base >=4.7 && <5 , deepseq , formatting , perf >=0.4.1.0 @@ -43,17 +33,16 @@ , tdigest , text , vector + , readme-lhs default-language: Haskell2010 executable perf-examples main-is: examples.hs - other-modules: - Paths_perf_analysis hs-source-dirs: examples ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -rtsopts -O2 build-depends: - base >=4.7 && <4.12 + base >=4.7 && <5 , containers , deepseq , formatting @@ -65,4 +54,5 @@ , tdigest , text , vector + , readme-lhs default-language: Haskell2010 diff --git a/src/Perf/Analysis.hs b/src/Perf/Analysis.hs --- a/src/Perf/Analysis.hs +++ b/src/Perf/Analysis.hs @@ -1,14 +1,7 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -fno-warn-type-defaults #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE NoImplicitPrelude #-} -- | analytical functionality for perf module Perf.Analysis where @@ -17,8 +10,8 @@ import Data.TDigest import Formatting import Perf -import Protolude hiding ((%)) -import qualified Data.Text as Text +import Protolude +import Readme.Lhs hiding (Format) -- | compute deciles -- @@ -55,51 +48,61 @@ int2Sci :: (Integral a) => a -> Scientific int2Sci n = scientific (fromIntegral n) 0 --- | format an Integral as a Scientific with a label and precision -formatInt :: (Integral a) => Text -> Int -> a -> Text -formatInt label p x = - sformat - ((right 24 ' ' %. stext) % - (left 8 ' ' %. prec p)) label (int2Sci x) +formatSecs :: (RealFloat a) => Int -> a -> Text +formatSecs p s + | s < 0 = "-" <> formatSecs p (-s) + | s >= 1 = formatFixed p s <> " s" + | s >= 1e-3 = formatFixed p (s*1e3) <> " ms" + | s >= 1e-6 = formatFixed p (s*1e6) <> " μs" + | s >= 1e-9 = formatFixed p (s*1e9) <> " ns" + | otherwise = formatFixed p (s*1e12) <> " ps" --- | format the first 5 results, and then the 40th percentile -formatRun :: (Integral a) => Text -> Int -> [a] -> Text -formatRun label p xs = - sformat - ((right 24 ' ' %. stext) % stext % - (left 9 ' ' %. prec p) % - (left 9 ' ' %. prec p)) - label - (Text.intercalate " " $ sformat (left 8 ' ' %. prec p) . - int2Sci <$> - take 3 xs) - (fromFloatDigits $ percentile 0.5 xs) - (fromFloatDigits $ average xs) +-- | format an Integral as a Scientific with a precision +formatI :: (Integral a) => Int -> a -> Text +formatI p x = sformat (prec p) (int2Sci x) --- | header for formatRun -formatRunHeader :: Text -formatRunHeader = - sformat - ((right 24 ' ' %. stext) % - (left 8 ' ' %. stext) % - (left 9 ' ' %. stext) % - (left 9 ' ' %. stext) % - (left 9 ' ' %. stext) % - (left 9 ' ' %. stext)) - "run" - "first" - "2nd" - "3rd" - "median" - "av." +-- | format a Float as a Scientific with a precision +formatF :: (RealFloat a) => Int -> a -> Text +formatF p x = sformat (prec p) (fromFloatDigits x) --- | format a tick result with an inside and outside measurement -formatGap :: (Integral a) => Int -> (a, ([a],b)) -> Text -formatGap a (co, (ci, _)) = - sformat - ("n = " %(left 7 ' ' %. prec 3)%" outside: "%(left 7 ' ' %. prec 3)%" inside: "%(left 7 ' ' %. prec 3)%" gap: "%(left 7 ' ' %. prec 3)) - (int2Sci a) (int2Sci co) (int2Sci $ sum ci) (int2Sci $ co - sum ci) +-- | format a Float as a Scientific with a precision +formatFixed :: (RealFloat a) => Int -> a -> Text +formatFixed p x = sformat (fixed p) (fromFloatDigits x) --- | place markdown backtics around text -code :: [Text] -> Text -code cs = "\n```\n" <> Text.intercalate "\n" cs <> "\n```\n" +-- | format the first few results, the median and average +formatRun :: (Integral a) => Text -> Int -> Int -> [a] -> [Text] +formatRun label n p xs = + [ label] <> + (formatI p <$> take n xs) <> + [ formatF p $ average xs + , formatF p $ percentile 0.5 xs + ] + +-- | average and time +formatRunTime :: (Integral a) => Text -> Double -> Int -> [a] -> [Text] +formatRunTime label npc p xs = + [ label] <> + [ formatF p $ npc * average xs + , formatF p $ average xs + ] + +formatRuns :: (Integral a) => Int -> Int -> [(Text, [a])] -> Block +formatRuns n p runs = + table + mempty + (["run"] <> + take n (["first", "second", "third"] <> ((<>"th") . show <$> [4::Int ..])) <> + ["average", "median"]) + ([AlignLeft] <> replicate (n+2) AlignRight) + (replicate (n+3) 0) + (fmap (\(l,as) -> formatRun l n p as) runs) + +formatRunsTime :: (Integral a) => Double -> Int -> [(Text, [a])] -> Block +formatRunsTime npc p runs = + table + mempty + ["run", "cputime", "cycles"] + [AlignLeft, AlignRight, AlignRight] + [] + (fmap (\(l,as) -> formatRunTime l npc p as) runs) + diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 --- a/stack.yaml +++ /dev/null @@ -1,11 +0,0 @@ -resolver: nightly-2018-05-28 - -packages: - - . - - ../perf - -extra-deps: - - rdtsc-1.3.0.1 - - tdigest-0.2 - -allow-newer: true