Source

floatshow / tests / benchmarking / benchmark.hs

Full commit
{-# LANGUAGE BangPatterns #-}
module Main (main) where

import System.Environment (getArgs, withArgs)
import Criterion.Main
import Data.Array.Unboxed
import Data.Array.Base (unsafeAt)
import System.Random
import Control.Monad (when)
import GHC.Float

import Text.FShow.RealFloat

test :: (Double -> Int) -> UArray Int Double -> Int -> Int
test conv arr len = loop len 0
  where
    loop 0 !acc = acc + conv (arr `unsafeAt` 0)
    loop k  acc = loop (k-1) (acc `max` conv (arr `unsafeAt` k))

fun1 :: Double -> Int
fun1 = length . show

fun2 :: Double -> Int
fun2 = length . fshow

fun3 :: Double -> Int
fun3 = length . show . D7


main :: IO ()
main = do
    args <- getArgs
    let (size, others) =
          case args of
            ("-bd":sz:more) -> (read sz, more)
            _               -> (10000, args)
    sg <- getStdGen
    let darr = mkDArr size sg
        farr = mkFArr size sg
        !ds = test ((`quot` 16) . fun1) darr size
        !fs = fest ((`quot` 16) . dun1) farr size
    when (ds == 0) (putStrLn "Jackpot Double")
    when (fs == 0) (putStrLn "Jackpot Float")
    withArgs others $
      defaultMain
        [ bench "show @ Double"
            (whnf (test fun1 darr) size)
        , bench "fshow @ Double"
            (whnf (test fun2 darr) size)
        , bench "show @ Double7"
            (whnf (test fun3 darr) size)
-- Now for Float -> Int
        , bench "show @ Float"
            (whnf (fest dun1 farr) size)
        , bench "fshow @ Float"
            (whnf (fest dun2 farr) size)
        , bench "show @ Float7"
            (whnf (fest dun3 farr) size)
        ]

fest :: (Float -> Int) -> UArray Int Float -> Int -> Int
fest conv arr len = loop len 0
  where
    loop 0 !acc = acc + conv (arr `unsafeAt` 0)
    loop k  acc = loop (k-1) (acc `max` conv (arr `unsafeAt` k))

dun1 :: Float -> Int
dun1 = length . show

dun2 :: Float -> Int
dun2 = length . fshow

dun3 :: Float -> Int
dun3 = length . show . F7

mkDArr :: Int -> StdGen -> UArray Int Double
mkDArr num = array (0,num) . zip [0 .. num] . randomRs (-1e308, 1e308)

mkFArr :: Int -> StdGen -> UArray Int Float
mkFArr num = array (0,num) . zip [0 .. num] . randomRs (-1e37,1e37)