BenchMorphParser.hs 1.51 KB
Newer Older
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
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)