perf-analysis-0.3.0: examples/examples.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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 #-}

module Main where

import Readme.Lhs
import Options.Generic
import Perf
import Perf.Analysis
import Protolude
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector as V
import qualified Data.Vector.Storable as S
import qualified Data.Vector.Unboxed as U

data Opts = Opts
  { runs :: Maybe Int -- <?> "number of runs"
  , sumTo :: Maybe Int -- <?> "sum to this number"
  , sumsTo :: Maybe [Int] -- <?> "sum to these numbers"
  } deriving (Generic, Show)

instance ParseField [Int]

instance ParseRecord Opts

-- | useful as a benchmark versus the `ticks` functions being imported
ticksInFile :: (NFData b) => Int -> (a -> b) -> a -> IO ([Cycle], b)
ticksInFile n0 f a = go f a n0 []
  where
    go f a n ts
      | n <= 0 = pure (ts, f a)
      | otherwise = do
          (t,_) <- tick f a
          go f a (n - 1) (t:ts)

-- | interposition of a lambda
fLambda :: Int -> Int
fLambda = \x -> foldl' (+) 0 [1 .. x]

-- | monomorphic version
fMono :: Int -> Int
fMono x = foldl' (+) 0 [1 .. x]

-- | polymorphic function version
fPoly :: (Integral b) => b -> b
fPoly x = foldl' (+) 0 [1 .. x]

main :: IO ()
main = do
  o :: Opts <- getRecord "perf examples"
  let !n = fromMaybe 1000 (runs o)
  let !a = fromMaybe 1000 (sumTo o)
  let !as = [1, 10, 100, 1000 :: Int]
  prewarmup <- tick_
  _ <- warmup 100
  onetick <- tick_
  ticks' <- replicateM 10 tick_
  manyticks <- replicateM 1000000 tick_
  let avticks = average manyticks
  let qticks = deciles 5 manyticks
  let tick999 = percentile 0.999 manyticks
  let tick99999 = percentile 0.99999 manyticks
  let tick99 = percentile 0.99 manyticks
  let tick40 = percentile 0.4 manyticks

  -- 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
  (t2,_) <- tick fMono a
  (t3,_) <- tick fMono a
  (t',_) <- tick' fMono a
  (tio,_) <- tickIO (pure $ fMono a)
  -- mystery: if tickNoinline is used at all, all tick computations slow down
  -- by a factor of 2 (or by a function call)
  -- (tn,_) <- tickNoinline fMono a
  t10 <- sequence $ replicate 10 (tick fMono a)
  t10io <- sequence $ replicate 10 (tickIO $ pure (fMono a))
  -- t10n <- sequence $ replicate 10 (tickNoinline fMono a)
  t10' <- sequence $ replicate 10 (tick fMono a)

  -- | ticks and ticksIO
  (rpure, _) <- ticks n fMono a
  (rpurePoly, _) <- ticks n fPoly a
  (rpureLambda, _) <- ticks n fLambda a
  (rio, _) <- ticksIO n (pure $ fMono a)
  (rioPoly, _) <- ticksIO n (pure $ fPoly a)
  (rioLambda, _) <- ticksIO n (pure $ fLambda a)

  -- | gaps
  gaps <- sequence $ (tickIO . ticks n fPoly) <$> as

  -- | ns testing
  css <-
    fmap (fmap fst) <$>
    sequence ((replicateM n . tick fMono) <$> as)
  (ts, _) <- ns (ticks n fMono) as

  -- | vectors
  let asl :: [Int]
      asl = [1 .. a]
  let suml :: [Int] -> Int
      suml = foldl' (+) 0
  (rlist, _) <- ticks n suml asl
  let sumv :: V.Vector Int -> Int
      sumv = V.foldl (+) 0
  let asv :: V.Vector Int =
        V.generate a identity
  (rboxed, _) <- ticks n sumv asv
  let sums :: S.Vector Int -> Int
      sums = S.foldl (+) 0
  let ass :: S.Vector Int =
        S.generate a identity
  (rstorable, _) <- ticks n sums ass
  let sumu :: U.Vector Int -> Int
      sumu = U.foldl (+) 0
  let asu :: U.Vector Int =
        U.generate a identity
  (runboxed, _) <- ticks n sumu asu

  -- WHNF
  (rnf, _) <- tick (fmap fMono) (Just a)
  (rwhnf, _) <- tick (fmap fMono) (Just a)
  (rnfs, _) <- ticks n (fmap fMono) (Just a)
  (rwhnfs, _) <- ticksWHNF n (fmap fMono) (Just a)
  (rnfio, _) <- tickIO (pure $ fmap fMono (Just a))
  (rwhnfio, _) <- tickWHNFIO (pure $ fmap fMono (Just a))
  (rnfsio, _) <- ticksIO n (pure $ fmap fMono (Just a))
  (rwhnfsio, _) <- ticksWHNFIO n (pure $ fmap fMono (Just a))

  void $ runOutput
    ("other/readme_.md", GitHubMarkdown)
    ("readme.md", GitHubMarkdown) $ do

    output "run" $ Native $ (:[]) $ table
      "run details"
      []
      [AlignLeft, AlignRight]
      [0, 0]
      [ ["number of runs", formatI 2 n]
      , ["accumulate to", formatI 2 a]
      , ["function", "foldl' (+) 0"]
      ]

    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", fixed 2 avticks]
      , ["99.999% perc", commas 0 tick99999]
      , ["99.9% perc", fixed 2 tick999]
      , ["99th perc", fixed 2 tick99]
      , ["40th perc", fixed 2 tick40]
      , ["[min, 20th, .. 80th, max]",
         Text.intercalate " " (formatF 4 <$> qticks)]
      ]

    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')]
        ]
      ]

    output "ticks" $ Native [formatRuns 3 2
      [ ("monomorphic", rpure)
      , ("includes lambda", rpureLambda)
      , ("polymorphic", rpurePoly)
      , ("ticksIO mono", rio)
      , ("ticksIO lambda", rioLambda)
      , ("ticksIO poly", rioPoly)
      ]]



    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)
      ]