{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-- | Per-field microbenchmark of the fast parsers against the reference ones.
module Main (main) where
import qualified Data.ByteString.Char8 as C
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import Data.Bits (shiftR, xor)
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (toModifiedJulianDay)
import Data.Word (Word64)
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Exts (Double (..), Int (..))
import Text.Printf (printf)
import qualified DataFrame.Internal.Parsing as Ref
import DataFrame.Internal.Parsing.Fast
fieldCount :: Int
fieldCount = 1000000
-- | SplitMix64 finalizer; deterministic pseudo-random stream.
mix64 :: Word64 -> Word64
mix64 z0 =
let z1 = (z0 `xor` (z0 `shiftR` 33)) * 0xFF51AFD7ED558CCD
z2 = (z1 `xor` (z1 `shiftR` 33)) * 0xC4CEB9FE1A85EC53
in z2 `xor` (z2 `shiftR` 33)
-- | Round-trip-precision doubles in the doubles_100mb shape.
doubleFields :: V.Vector C.ByteString
doubleFields = V.generate fieldCount gen
where
gen i =
let w = mix64 (fromIntegral i + 1)
mag = fromIntegral (w `shiftR` 11) / 9007199254740992 :: Double
scaled = (mag - 0.5) * 2000000
in C.pack (show scaled)
intFields :: V.Vector C.ByteString
intFields = V.generate fieldCount gen
where
gen i =
let w = mix64 (fromIntegral i + 0x9E3779B97F4A7C15)
spans = [99, 9999, 999999, 99999999, 9223372036854775807] :: [Word64]
bound = spans !! (i `mod` 5)
v = toInteger (w `mod` bound) - toInteger (bound `div` 2)
in C.pack (show v)
boolFields :: V.Vector C.ByteString
boolFields = V.generate fieldCount gen
where
gen i = map C.pack ["True", "False", "true", "false", "TRUE", "FALSE"] !! (i `mod` 6)
dateFields :: V.Vector C.ByteString
dateFields = V.generate fieldCount gen
where
gen i =
let w = mix64 (fromIntegral i + 7)
y = 1900 + fromIntegral (w `mod` 200) :: Int
m = 1 + fromIntegral ((w `shiftR` 8) `mod` 12) :: Int
d = 1 + fromIntegral ((w `shiftR` 16) `mod` 28) :: Int
pad2 n = (if n < 10 then "0" else "") ++ show n
in C.pack (show y ++ "-" ++ pad2 m ++ "-" ++ pad2 d)
-- | mixed_100mb-flavoured missing-check stream: mostly non-missing.
missingFields :: V.Vector C.ByteString
missingFields = V.generate fieldCount gen
where
gen i =
map C.pack ["12345", "NA", "hello world", "", "3.14159", "Nothing", "x", "null"]
!! (i `mod` 8)
forceBS :: V.Vector C.ByteString -> Int
forceBS = V.foldl' (\ !acc b -> acc + C.length b) 0
forceT :: V.Vector T.Text -> Int
forceT = V.foldl' (\ !acc t -> acc + T.length t) 0
-- | Best-of-5 wall nanoseconds for a strict fold over the fields.
bench :: V.Vector a -> (a -> Double) -> IO Double
bench fields step = minimum <$> mapM run [1 .. 5 :: Int]
where
-- Seed the fold with the run index so it is not shared between runs.
run k = do
t0 <- getMonotonicTimeNSec
let !s = V.foldl' (\ !acc f -> acc + step f) (fromIntegral k) fields
s `seq` return ()
t1 <- getMonotonicTimeNSec
return (fromIntegral (t1 - t0))
report :: String -> Double -> Double -> IO ()
report name refNs fastNs = do
let n = fromIntegral fieldCount
printf
"%-34s ref %8.1f ns/field fast %7.1f ns/field speedup %5.2fx\n"
name
(refNs / n)
(fastNs / n)
(refNs / fastNs)
mb :: Maybe Bool -> Double
mb = maybe 0 (\b -> if b then 1 else 2)
mi :: Maybe Int -> Double
mi = fromIntegral . fromMaybe 0
md :: Maybe Double -> Double
md = fromMaybe 0
main :: IO ()
main = do
printf "fields per stream: %d (best of 5 runs)\n\n" fieldCount
let doubleTexts = V.map TE.decodeUtf8Lenient doubleFields
intTexts = V.map TE.decodeUtf8Lenient intFields
printf
"force: %d\n\n"
( forceBS doubleFields
+ forceBS intFields
+ forceBS boolFields
+ forceBS missingFields
+ forceBS dateFields
+ forceT doubleTexts
+ forceT intTexts
)
refD <- bench doubleFields (md . Ref.readByteStringDouble)
refDT <- bench doubleTexts (md . Ref.readDouble)
fastD <- bench doubleFields (md . parseDoubleField)
fastDU <-
bench doubleFields $ \f ->
case parseDoubleField# f 0 (C.length f) of
(# 0#, _ #) -> 0
(# _, d #) -> D# d
report "double (vs readByteStringDouble)" refD fastD
report "double (vs Text readDouble)" refDT fastD
report "double unboxed core (vs BS ref)" refD fastDU
refI <- bench intFields (mi . Ref.readByteStringInt)
refIT <- bench intTexts (mi . Ref.readInt)
fastI <- bench intFields (mi . parseIntField)
fastIU <-
bench intFields $ \f ->
case parseIntField# f 0 (C.length f) of
(# 0#, _ #) -> 0
(# _, n #) -> fromIntegral (I# n)
report "int (vs readByteStringInt)" refI fastI
report "int (vs Text readInt)" refIT fastI
report "int unboxed core (vs BS ref)" refI fastIU
refB <- bench boolFields (mb . Ref.readByteStringBool)
fastB <- bench boolFields (mb . parseBoolField)
report "bool (vs readByteStringBool)" refB fastB
refM <- bench missingFields (\f -> if Ref.isNullishBS f then 1 else 0)
fastM <- bench missingFields (\f -> if isMissingField f then 1 else 0)
report "missing (vs isNullishBS)" refM fastM
let mday = maybe 0 (fromIntegral . toModifiedJulianDay)
refDay <- bench dateFields (mday . Ref.readByteStringDate "%Y-%m-%d")
fastDay <- bench dateFields (mday . parseDateField)
report "date %Y-%m-%d (vs parseTimeM)" refDay fastDay