diff --git a/bench/BenchMain.hs b/bench/BenchMain.hs new file mode 100644 index 0000000000000000000000000000000000000000..f8ea12c44196aa71defcb4bc23c7019b7a4df0a7 --- /dev/null +++ b/bench/BenchMain.hs @@ -0,0 +1,10 @@ +module Main where + +import Criterion.Main + +import qualified BenchMorphParser as MorphParser + +main :: IO () +main = defaultMain + [ MorphParser.benchmarks + ] diff --git a/bench/BenchMorphParser.hs b/bench/BenchMorphParser.hs new file mode 100644 index 0000000000000000000000000000000000000000..bbe374c9f2f61d83f89623df6827364e9c975f66 --- /dev/null +++ b/bench/BenchMorphParser.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +module BenchMorphParser (benchmarks) where + +import Criterion + +import qualified Data.List.NonEmpty as NonEmpty + +import Data.Text (Text) +import Control.DeepSeq + +import MA.Coalgebra.Parser +import MA.Coalgebra.RefinementTypes +import MA.FunctorExpression.Sorts +import MA.FunctorExpression.Type +import MA.FunctorExpression.Parser +import MA.Functors.Polynomial +import MA.Functors + +benchmarks :: Benchmark +benchmarks = bgroup "Morphism Parser" + [ benchIdentity + , benchMarkov + ] + +benchIdentity :: Benchmark +benchIdentity = bgroup "Identity" $ + let f = (Functor 1 (mkPoly [[Identity Variable]])) + in + [ benchParser "simple" f "x: y\ny: z\nz: x" + , benchParser "predefined" f "x: x\ny: y\nz: z" + ] + +benchMarkov :: Benchmark +benchMarkov = bgroup "Ax(R^X)" $ + let Right f = annotateSorts <$> parseFunctorExpression registeredFunctors "" "{a,b,c,d,e}x(R^X)" + in + [ benchParser "simple" f + "x: (a, {x: 0.5, y: 0.5})\n\ + \y: (b, {y: 0.7, x: 0.2, z: 0.1})\n\ + \z: (c, {z: 1.0})" + ] + +benchParser :: + (Functor f, ParseMorphism f, NFData (Label f), NFData (H1 f)) + => String + -> FunctorExpression f Sort + -> Text + -> Benchmark +benchParser name fexpr input = bench name (nf parse input) + where + parse = parseMorphisms fexpr "" + +mkPoly :: [[Factor a]] -> Polynomial a +mkPoly = + Polynomial . Sum . NonEmpty.fromList . map (Product . NonEmpty.fromList)