encodeOctal Benchmark

encodeOctal.hs

{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where

import           Control.Monad.Catch
import           Criterion.Main
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as S
import           Data.ByteString.Builder
import           Data.Monoid
import           GHC.Generics
import           Numeric

data OverflowException = OverflowException String deriving (Show, Generic)

instance Exception OverflowException

main :: IO ()
main = defaultMain $ map (makeGroup baseInt) [7, 11]
                  ++ map (makeGroup baseInteger) [100, 1000]
  where
    baseInt = 8 :: Int
    baseInteger = 8 :: Integer
    makeGroup base size =
      bgroup
        (show size)
        [ bgroup
            "small num"
            [ bench "ByteString/unfoldrN" $
              nfIO (toLazyByteString <$> encodeOctal size base)
            , bench "Builder/monoid" $ nfIO (toLazyByteString <$> encodeOctal' size base)
            , bench "Numeric" $ nfIO (toLazyByteString <$> encodeOctal'' size base)
            ]
        , bgroup
            "big num"
            [ bench "ByteString/unfoldrN" $
              nfIO (toLazyByteString <$> encodeOctal size (base ^ size - 1))
            , bench "Builder/monoid" $
              nfIO (toLazyByteString <$> encodeOctal' size (base ^ size - 1))
            , bench "Numeric" $
              nfIO (toLazyByteString <$> encodeOctal'' size (base ^ size - 1))
            ]
        ]

encodeOctal :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal !len !val = do
    enc <- case S.unfoldrN len toOctal val of
        (valStr, Just 0) -> return valStr
        over -> throwM $ OverflowException $ "<encodeOctal>: Tar value overflow: " ++ show over
    return (byteString $ S.reverse enc)
  where
    toOctal 0 = Just (0, 0)
    toOctal x =
        let !(q, r) = x `quotRem` 8
        in Just (fromIntegral r + 48, q)


encodeOctal' :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal' !len !val = go 0 val mempty
  where
    go !n !cur !acc
      | cur == 0 =
        if n < len
          then return $ byteString (S.replicate (len - n) 48) <> acc
          else return acc
      | n < len =
        let !(q, r) = cur `quotRem` 8
        in go (n + 1) q (word8 (fromIntegral r + 48) <> acc)
      | otherwise =
        throwM $
        OverflowException $
        "<encodeOctal>: Tar value overflow (for maxLen " ++ show len ++ "): " ++ show val


encodeOctal'' :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal'' !len !val = return $ byteString (S.replicate (len - length enc) 48) <> string7 enc
  where enc = showOct val ""

Doing the same process with very large 1000 digit number shows a 10x loss of unfoldrN to Builder and Numeric approaches. This is due to the fact that recursion is short circuited and zeros are filled with S.replicate (len - n) 48 for the latter two. Lack of that optimization is clearly observer when there are no leading zeros, since ByteString's unfoldrN approach is actually slightly faster.

$ stack bench --benchmark-arguments='--match prefix "1000/small"'
encodeOctal-0.1.0.0: benchmarks
Running 1 benchmarks...
Benchmark bench: RUNNING...
benchmarking 1000/small num/ByteString/unfoldrN
time                 10.91 μs   (10.53 μs .. 11.37 μs)
                     0.981 R²   (0.966 R² .. 0.993 R²)
mean                 11.19 μs   (10.77 μs .. 12.28 μs)
std dev              2.136 μs   (1.377 μs .. 3.632 μs)
variance introduced by outliers: 96% (severely inflated)

benchmarking 1000/small num/Builder/monoid
time                 1.007 μs   (959.3 ns .. 1.057 μs)
                     0.972 R²   (0.949 R² .. 0.985 R²)
mean                 1.067 μs   (992.5 ns .. 1.203 μs)
std dev              344.5 ns   (184.3 ns .. 597.8 ns)
variance introduced by outliers: 99% (severely inflated)

benchmarking 1000/small num/Numeric
time                 1.199 μs   (1.152 μs .. 1.264 μs)
                     0.965 R²   (0.928 R² .. 0.987 R²)
mean                 1.422 μs   (1.207 μs .. 2.194 μs)
std dev              1.234 μs   (254.4 ns .. 2.551 μs)
variance introduced by outliers: 100% (severely inflated)

Benchmark bench: FINISH
$ stack bench --benchmark-arguments='--match prefix "1000/big"'
encodeOctal-0.1.0.0: benchmarks
Running 1 benchmarks...
Benchmark bench: RUNNING...
benchmarking 1000/big num/ByteString/unfoldrN
time                 250.1 μs   (235.7 μs .. 267.5 μs)
                     0.968 R²   (0.945 R² .. 0.991 R²)
mean                 256.8 μs   (241.4 μs .. 294.6 μs)
std dev              74.28 μs   (28.29 μs .. 136.6 μs)
variance introduced by outliers: 98% (severely inflated)

benchmarking 1000/big num/Builder/monoid
time                 277.7 μs   (267.7 μs .. 290.0 μs)
                     0.976 R²   (0.952 R² .. 0.991 R²)
mean                 295.3 μs   (282.3 μs .. 314.5 μs)
std dev              51.12 μs   (35.25 μs .. 69.23 μs)
variance introduced by outliers: 92% (severely inflated)

benchmarking 1000/big num/Numeric
time                 320.8 μs   (308.9 μs .. 334.5 μs)
                     0.982 R²   (0.968 R² .. 0.991 R²)
mean                 349.0 μs   (335.2 μs .. 372.3 μs)
std dev              58.82 μs   (42.38 μs .. 78.70 μs)
variance introduced by outliers: 91% (severely inflated)

Benchmark bench: FINISH

Adding the short circuit to unfoldrN approach speeds it up for large zero padded numbers:

encodeOctal :: (Show a, Integral a, MonadThrow m) => Int -> a -> m Builder
encodeOctal !len !val = do
  case S.unfoldrN len toOctal val of
    (valStr, Nothing) ->
      return $ byteString (S.replicate (len - S.length valStr) 48) <> byteString (S.reverse valStr)
    (valStr, Just 0) -> return $ byteString $ S.reverse valStr
    over -> throwM $ OverflowException $ "<encodeOctal>: Tar value overflow: " ++ show over
  where
    toOctal 0 = Nothing
    toOctal x =
      let !(q, r) = x `quotRem` 8
      in Just (fromIntegral r + 48, q)