BenchParser.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Copar.Coalgebra.BenchParser
  ( benchmarks
  , benchParser
  ) where

import           Criterion

import qualified Data.List.NonEmpty as NonEmpty

import           Data.Text (Text)
import           Control.DeepSeq

import           Copar.Coalgebra.Parser
import           Copar.RefinementInterface
import           Copar.FunctorExpression.Sorts
import           Copar.FunctorExpression.Type
import           Copar.FunctorExpression.Parser
import           Copar.Functors.Polynomial
import           Copar.Functors
import           Copar.FunctorDescription

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
    functors = map (map functorExprParser) registeredFunctors
    Right f = annotateSorts <$> parseFunctorExpression functors "" "{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 (F1 f))
  => String
  -> FunctorExpression f Sort
  -> Text
  -> Benchmark
benchParser benchmarkName fexpr input = bench benchmarkName (nf parse input)
  where
    parse = parseMorphisms fexpr EnableSanityChecks ""

mkPoly :: [[Factor a]] -> Polynomial a
mkPoly =
  Polynomial . Sum . NonEmpty.fromList . map (Product . NonEmpty.fromList)