rdf4h-4.0.1: bench/MainCriterion.hs
{-# LANGUAGE OverloadedStrings, LambdaCase, RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Prelude hiding (readFile)
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
import Criterion
import Criterion.Types
import Criterion.Main
import Data.RDF
import Text.RDF.RDF4H.ParserUtils
import qualified Data.Text as T
import Control.DeepSeq (NFData)
-- The `bills.102.rdf` XML file is needed to run this benchmark suite
--
-- $ wget https://www.govtrack.us/data/rdf/bills.099.actions.rdf.gz
-- $ gzip -d bills.099.actions.rdf.gz
parseXmlRDF :: Rdf a => T.Text -> RDF a
parseXmlRDF = either (error . show) id . parseString (XmlParser Nothing Nothing)
{-# INLINE parseXmlRDF #-}
parseNtRDF :: Rdf a => T.Text -> RDF a
parseNtRDF = either (error . show) id . parseString NTriplesParser
{-# INLINE parseNtRDF #-}
parseTtlRDF :: Rdf a => T.Text -> RDF a
parseTtlRDF = either (error . show) id . parseString (TurtleParser Nothing Nothing)
{-# INLINE parseTtlRDF #-}
queryGr :: Rdf a => (Maybe Node,Maybe Node,Maybe Node,RDF a) -> [Triple]
queryGr (maybeS,maybeP,maybeO,rdf) = query rdf maybeS maybeP maybeO
selectGr :: Rdf a => (NodeSelector,NodeSelector,NodeSelector,RDF a) -> [Triple]
selectGr (selectorS,selectorP,selectorO,rdf) = select rdf selectorS selectorP selectorO
xmlFile :: FilePath
xmlFile = "bills.099.actions.rdf"
main :: IO ()
main = defaultMainWith
(defaultConfig {resamples = 100})
[ env
-- [FIXME] Do not rely on system's defaults to read files.
(do fawltyContentTurtle <- readFile "data/ttl/fawlty1.ttl"
fawltyContentNTriples <- readFile "data/nt/all-fawlty-towers.nt"
xmlContent <- readFile xmlFile
let rdf1' = parseString (XmlParser Nothing Nothing) xmlContent
rdf2' = parseString (XmlParser Nothing Nothing) xmlContent
rdf3' =parseString (XmlParser Nothing Nothing) xmlContent
rdf1 = either (error . show) id rdf1' :: RDF TList
rdf2 = either (error . show) id rdf2' :: RDF AdjHashMap
rdf3 = either (error . show) id rdf3' :: RDF AlgebraicGraph
triples = triplesOf rdf1
return (rdf1, rdf2, rdf3, triples, fawltyContentNTriples, fawltyContentTurtle, xmlContent)) $
\ ~(triplesList, adjMap, algGraph, triples, fawltyContentNTriples, fawltyContentTurtle, xmlContent) ->
bgroup
"rdf4h"
[ bgroup
"parsers"
[ bench "ntriples-parsec" $
nf (\t ->
let res = parseString (NTriplesParserCustom Parsec) t :: Either ParseFailure (RDF TList)
in either (error . show) id res
) fawltyContentNTriples
, bench "ntriples-attoparsec" $
nf (\t ->
let res = parseString (NTriplesParserCustom Attoparsec) t :: Either ParseFailure (RDF TList)
in either (error . show) id res
) fawltyContentNTriples
, bench "turtle-parsec" $
nf (\t ->
let res = parseString (TurtleParserCustom Nothing Nothing Parsec) t :: Either ParseFailure (RDF TList)
in either (error . show) id res
) fawltyContentTurtle
, bench "turtle-attoparsec" $
nf (\t ->
let res = parseString (TurtleParserCustom Nothing Nothing Attoparsec) t :: Either ParseFailure (RDF TList)
in either (error . show) id res
) fawltyContentTurtle
, bench "xml-xmlbf" $
nf (\t ->
let res = parseString (XmlParser Nothing Nothing) t :: Either ParseFailure (RDF TList)
in either (error . show) id res
) xmlContent
-- , bench "xml-xht" $
-- nf (\t ->
-- let res = parseString (XmlParserHXT Nothing Nothing) t :: Either ParseFailure (RDF TList)
-- in either (error . show) id res
-- ) xmlContent
]
,
bgroup
"query"
(queryBench "TList" triplesList <>
queryBench "AdjHashMap" adjMap <>
queryBench "AlgebraicGraph" algGraph
-- queryBench "SP" mapSP <> queryBench "HashSP" hashMapSP
)
, bgroup
"select"
(selectBench "TList" triplesList <>
selectBench "AdjHashMap" adjMap <>
selectBench "AlgebraicGraph" algGraph
-- selectBench "SP" mapSP <> selectBench "HashSP" hashMapSP
)
, bgroup
"add-remove-triples"
(addRemoveTriples "TList" triples (empty :: RDF TList) triplesList <>
addRemoveTriples "AdjHashMap" triples (empty :: RDF AdjHashMap) adjMap <>
addRemoveTriples "AlgebraicGraph" triples (empty :: RDF AlgebraicGraph) algGraph
)
, bgroup
"count_triples"
[ bench "TList" (nf (length . triplesOf) triplesList)
, bench "AdjHashMap" (nf (length . triplesOf) adjMap)
, bench "AlgebraicGraph" (nf (length . triplesOf) algGraph)
]
]
]
selectBench :: Rdf a => String -> RDF a -> [Benchmark]
selectBench label gr =
[ bench (label <> " SPO") $ nf selectGr (subjSelect,predSelect,objSelect,gr)
, bench (label <> " SP") $ nf selectGr (subjSelect,predSelect,selectNothing,gr)
, bench (label <> " S") $ nf selectGr (subjSelect,selectNothing,selectNothing,gr)
, bench (label <> " PO") $ nf selectGr (selectNothing,predSelect,objSelect,gr)
, bench (label <> " SO") $ nf selectGr (subjSelect,selectNothing,objSelect,gr)
, bench (label <> " P") $ nf selectGr (selectNothing,predSelect,selectNothing,gr)
, bench (label <> " O") $ nf selectGr (selectNothing,selectNothing,objSelect,gr)
]
subjSelect, predSelect, objSelect, selectNothing :: Maybe (Node -> Bool)
subjSelect = Just (\case { (UNode n) -> T.length n > 12 ; _ -> False })
predSelect = Just (\case { (UNode n) -> T.length n > 12 ; _ -> False })
objSelect = Just (\case { (UNode n) -> T.length n > 12 ; _ -> False })
selectNothing = Nothing
subjQuery, predQuery, objQuery, queryNothing :: Maybe Node
subjQuery = Just (UNode "http://www.rdfabout.com/rdf/usgov/congress/99/bills/h4")
predQuery = Just (UNode "bill:hadAction")
objQuery = Just (BNodeGen 1)
queryNothing = Nothing
queryBench :: Rdf a => String -> RDF a -> [Benchmark]
queryBench label gr =
[ bench (label <> " SPO") $ nf queryGr (subjQuery,predQuery,objQuery,gr)
, bench (label <> " SP") $ nf queryGr (subjQuery,predQuery,queryNothing,gr)
, bench (label <> " S") $ nf queryGr (subjQuery,queryNothing,queryNothing,gr)
, bench (label <> " PO") $ nf queryGr (queryNothing,predQuery,objQuery,gr)
, bench (label <> " SO") $ nf queryGr (subjQuery,queryNothing,objQuery,gr)
, bench (label <> " P") $ nf queryGr (queryNothing,predQuery,queryNothing,gr)
, bench (label <> " O") $ nf queryGr (queryNothing,queryNothing,objQuery,gr)
]
addRemoveTriples :: (NFData (RDF a), Rdf a) => String -> Triples -> RDF a -> RDF a -> [Benchmark]
addRemoveTriples lbl triples emptyGr populatedGr =
[ bench (lbl <> "-add-triples") $ nf addTriples (triples,emptyGr)
, bench (lbl <> "-remove-triples") $ nf removeTriples (triples,populatedGr)
]
addTriples :: Rdf a => (Triples,RDF a) -> RDF a
addTriples (triples,emptyGr) =
foldr (flip addTriple) emptyGr triples
removeTriples :: Rdf a => (Triples,RDF a) -> RDF a
removeTriples (triples,populatedGr) =
foldr (flip removeTriple) populatedGr triples