----------------------------------------------------------------------------- -- | -- Module : BenchThroughput -- Copyright : Simon Meier -- License : BSD3-style (see LICENSE) -- -- Maintainer : Simon Meier <iridcode@gmail.com> -- Stability : experimental -- Portability : GHC -- -- This benchmark is based on 'tests/Benchmark.hs' from the 'binary-0.5.0.2' -- package. -- -- Benchmark the throughput of 'blaze-builder' and 'binary' for serializing -- sequences of 'Word8' .. 'Word64' values in little-endian, big-endian, and -- "host-endian" formats. -- -- The results on a Core2 Duo T7500 with Linux 2.6.32-24 i686 and GHC 6.12.3 -- are as follows: -- -- Using the Blaze.Builder directly (i.e. not encapsulated in a writer monad -- as Put is doing it) gives the best scalability. Up to 'Word32', it holds -- that the bigger the chunk size, the bigger the relative speedup of using -- the Blaze.Builder. For 'Word64', the speedup is not as impressive. -- Probably due to the more expensive writes. -- ----------------------------------------------------------------------------- module BenchThroughput (main) where import qualified Throughput.BinaryBuilder as BinaryBuilder import qualified Throughput.BinaryPut as BinaryPut import qualified Throughput.BinaryBuilderDeclarative as BinaryBuilderDecl import qualified Throughput.BlazeBuilder as BlazeBuilder import qualified Throughput.BlazePut as BlazePut import qualified Throughput.BlazeBuilderDeclarative as BlazeBuilderDecl import Throughput.Utils import Throughput.Memory import qualified Data.ByteString.Lazy as L import Debug.Trace import Data.Binary import Data.Binary.Put import Data.Binary.Get import Control.Exception import Control.Monad import System.CPUTime import Numeric import Text.Printf import System.Environment import System.IO import Data.Maybe import Data.Accessor import Data.Colour import Data.Colour.Names import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Gtk -- The different serialization functions ---------------------------------------- supportAllSizes f wS cS e i = return $ f wS cS e i blazeLineStyle = solidLine 1 . opaque binaryLineStyle = dashedLine 1 [5, 5] . opaque blazeBuilder = ( "BlazeBuilder" , blazeLineStyle green , supportAllSizes $ BlazeBuilder.serialize) blazeBuilderDecl = ( "BlazeBuilderDecl" , blazeLineStyle blue , supportAllSizes $ BlazeBuilderDecl.serialize) blazePut = ( "BlazePut" , blazeLineStyle red , supportAllSizes $ BlazePut.serialize) binaryBuilder = ( "BinaryBuilder" , binaryLineStyle green , supportAllSizes $ BinaryBuilder.serialize) binaryBuilderDecl = ( "BinaryBuilderDecl" , binaryLineStyle blue , BinaryBuilderDecl.serialize) binaryPut = ( "BinaryPut" , binaryLineStyle red , supportAllSizes $ BinaryPut.serialize) main :: IO () main = do mb <- getArgs >>= readIO . head -- memBench (mb*10) putStrLn "" putStrLn "Binary serialisation benchmarks:" -- do bytewise -- sequence_ -- [ test wordSize chunkSize Host mb -- | wordSize <- [1] -- , chunkSize <- [1,2,4,8,16] -- ] -- now Word16 .. Word64 let lift f wS cS e i = return $ f wS cS e i serializers = [ blazeBuilder , blazeBuilderDecl , blazePut , binaryBuilder, binaryBuilderDecl, binaryPut ] wordSizes = [1,2,4,8] chunkSizes = [1,2,4,8,16] endians = [Host,Big,Little] let compares = [ compareResults serialize wordSize chunkSize end mb | wordSize <- wordSizes , chunkSize <- chunkSizes , end <- endians , serialize <- serializers , wordSize /= 1 || end == Host -- no endianess for Word8 ] -- putStrLn "checking equality of serialization results:" -- sequence_ compares let serializes = [ [ ( serialize , [ (chunkSize, test serialize wordSize chunkSize end mb) | chunkSize <- [1,2,4,8,16] ] ) | serialize <- serializers ] | wordSize <- [1,2,4,8] , end <- [Host,Big,Little] , wordSize /= 1 || end == Host -- no endianess for Word8 ] putStrLn "\n\nbenchmarking serialization speed:" results <- mapM mkChart serializes print results mkChart :: [((String,CairoLineStyle,a), [(Int, IO (Maybe Double))])] -> IO () mkChart task = do lines <- catMaybes `liftM` mapM measureSerializer task let plottedLines = flip map lines $ \ ((name,lineStyle,_), points) -> plot_lines_title ^= name $ plot_lines_style ^= lineStyle $ plot_lines_values ^= [points] $ defaultPlotLines let layout = defaultLayout1 { layout1_plots_ = map (Right . toPlot) plottedLines } return () -- renderableToWindow (toRenderable layout) 640 480 measureSerializer :: (a, [(Int, IO (Maybe Double))]) -> IO (Maybe (a, [(Int,Double)])) measureSerializer (info, tests) = do optPoints <- forM tests $ \ (x, test) -> do optY <- test case optY of Nothing -> return Nothing Just y -> return $ Just (x, y) case catMaybes optPoints of [] -> return Nothing points -> return $ Just (info, points) ------------------------------------------------------------------------ time :: IO a -> IO Double time action = do start <- getCPUTime action end <- getCPUTime return $! (fromIntegral (end - start)) / (10^12) ------------------------------------------------------------------------ test :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) -> Int -> Int -> Endian -> Int -> IO (Maybe Double) test (serializeName, _, serialize) wordSize chunkSize end mb = do let bytes :: Int bytes = mb * 2^20 iterations = bytes `div` wordSize case serialize wordSize chunkSize end iterations of Nothing -> return Nothing Just bs -> do _ <- printf "%17s: %dMB of Word%-2d in chunks of %2d (%6s endian):" serializeName (mb :: Int) (8 * wordSize :: Int) (chunkSize :: Int) (show end) putSeconds <- time $ evaluate (L.length bs) -- getSeconds <- time $ evaluate sum -- print (L.length bs, sum) let putThroughput = fromIntegral mb / putSeconds -- getThroughput = fromIntegral mb / getSeconds _ <- printf "%6.1f MB/s write\n" putThroughput -- getThroughput -- (getThroughput/putThroughput) hFlush stdout return $ Just putThroughput ------------------------------------------------------------------------ compareResults :: (String, a, Int -> Int -> Endian -> Int -> Maybe L.ByteString) -> Int -> Int -> Endian -> Int -> IO () compareResults (serializeName, _, serialize) wordSize chunkSize end mb0 = do let mb :: Int mb = max 1 (mb0 `div` 100) bytes :: Int bytes = mb * 2^20 iterations = bytes `div` wordSize bs0 = BinaryBuilder.serialize wordSize chunkSize end iterations case serialize wordSize chunkSize end iterations of Nothing -> return () Just bs1 -> do _ <- printf "%17s: %dMB of Word%-2d in chunks of %2d (%6s endian):" serializeName (mb :: Int) (8 * wordSize :: Int) (chunkSize :: Int) (show end) if (bs0 == bs1) then putStrLn " Ok" else putStrLn " Failed" hFlush stdout