Skip to content

Commit

Permalink
Using Writer monad for recording bench rows
Browse files Browse the repository at this point in the history
  • Loading branch information
min-nguyen committed Oct 9, 2023
1 parent bb481bf commit 115c4a5
Show file tree
Hide file tree
Showing 3 changed files with 109 additions and 142 deletions.
134 changes: 67 additions & 67 deletions Benchmarks/benchmarks.csv
View file
Original file line number Diff line number Diff line change
@@ -1,67 +1,67 @@
Test-Name,Trace-Bwd,Trace-Eval,Trace-Fwd,Graph-Bwd,Graph-BwdAll,Graph-BwdDual,Graph-Eval,Graph-Fwd,Graph-FwdAsDeMorgan,Graph-FwdDual
arithmetic,17.0,10.0,2.0,1.0,1.0,1.0,4.0,0.0,5.0,0.0
array,10.0,11.0,4.0,1.0,2.0,0.0,10.0,0.0,4.0,0.0
compose,14.0,23.0,1.0,1.0,0.0,0.0,2.0,0.0,5.0,0.0
dicts,8.0,7.0,2.0,1.0,2.0,0.0,8.0,0.0,5.0,0.0
div-mod-quot-rem,8.0,7.0,5.0,0.0,3.0,1.0,5.0,2.0,4.0,0.0
factorial,13.0,9.0,8.0,0.0,32.0,0.0,7.0,0.0,158.0,0.0
filter,16.0,14.0,3.0,1.0,1.0,0.0,5.0,6.0,3.0,0.0
first-class-constr,10.0,11.0,3.0,0.0,2.0,0.0,5.0,1.0,3.0,0.0
flatten,10.0,10.0,3.0,2.0,3.0,1.0,8.0,0.0,8.0,0.0
foldr_sumSquares,9.0,10.0,3.0,0.0,2.0,0.0,6.0,0.0,2.0,0.0
lexicalScoping,8.0,7.0,1.0,1.0,0.0,0.0,1.0,0.0,11.0,0.0
length,10.0,8.0,1.0,1.0,3.0,0.0,2.0,0.0,2.0,0.0
lookup,7.0,11.0,5.0,1.0,1.0,0.0,6.0,0.0,3.0,0.0
map,8.0,10.0,3.0,1.0,2.0,1.0,6.0,0.0,3.0,0.0
mergeSort,18.0,18.0,16.0,0.0,2.0,0.0,18.0,0.0,6.0,0.0
normalise,14.0,17.0,2.0,0.0,1.0,0.0,3.0,0.0,10.0,0.0
pattern-match,9.0,15.0,6.0,0.0,1.0,0.0,8.0,0.0,6.0,0.0
range,26.0,18.0,13.0,1.0,2.0,0.0,15.0,0.0,8.0,0.0
records,10.0,8.0,3.0,0.0,1.0,0.0,8.0,0.0,4.0,0.0
reverse,7.0,13.0,1.0,0.0,0.0,0.0,6.0,0.0,3.0,0.0
dtw/next-indices,62.0,80.0,57.0,2.0,151.0,2.0,84.0,6.0,768.0,0.0
dtw/cost-matrix,64.0,55.0,39.0,2.0,8.0,1.0,84.0,3.0,108.0,0.0
dtw/matrix-update,11.0,7.0,2.0,1.0,1.0,0.0,3.0,0.0,3.0,0.0
desugar/list-comp-1,16.0,24.0,16.0,1.0,2.0,0.0,20.0,0.0,7.0,0.0
desugar/list-comp-2,53.0,56.0,59.0,1.0,9.0,1.0,73.0,2.0,27.0,0.0
desugar/list-comp-3,19.0,18.0,13.0,1.0,1.0,0.0,17.0,0.0,8.0,0.0
desugar/list-comp-4,10.0,11.0,4.0,1.0,1.0,0.0,9.0,0.0,4.0,0.0
desugar/list-comp-5,7.0,15.0,4.0,0.0,1.0,0.0,5.0,1.0,3.0,0.0
desugar/list-comp-6,11.0,9.0,0.0,0.0,0.0,0.0,1.0,0.0,2.0,0.0
desugar/list-comp-7,12.0,15.0,6.0,0.0,0.0,0.0,7.0,1.0,3.0,0.0
desugar/list-enum,10.0,12.0,2.0,2.0,6.0,0.0,6.0,0.0,8.0,0.0
add,10.0,5.0,0.0,0.0,0.0,1.0,1.0,1.0,2.0,0.0
array/lookup,19.0,22.0,18.0,1.0,0.0,0.0,31.0,0.0,17.0,0.0
array/dims,11.0,16.0,2.0,0.0,1.0,0.0,12.0,1.0,3.0,0.0
convolution/edgeDetect,1082.0,1427.0,1619.0,30.0,38.0,0.0,2479.0,9.0,4066.0,305.0
convolution/emboss,901.0,1188.0,1282.0,25.0,32.0,0.0,1958.0,2.0,3739.0,362.0
convolution/gaussian,996.0,1264.0,1357.0,26.0,34.0,1.0,2052.0,2.0,3828.0,372.0
dict/create,8.0,6.0,0.0,1.0,3.0,0.0,1.0,0.0,2.0,0.0
dict/difference,6.0,7.0,1.0,1.0,1.0,0.0,3.0,0.0,6.0,0.0
dict/disjointUnion,6.0,5.0,0.0,1.0,1.0,0.0,1.0,0.0,6.0,0.0
dict/foldl,32.0,41.0,18.0,2.0,1.0,0.0,22.0,1.0,10.0,0.0
dict/intersectionWith,11.0,8.0,2.0,1.0,1.0,1.0,4.0,1.0,10.0,0.0
dict/fromRecord,6.0,9.0,1.0,1.0,3.0,1.0,1.0,0.0,2.0,0.0
dict/get,8.0,5.0,1.0,5.0,1.0,0.0,2.0,0.0,2.0,0.0
dict/map,23.0,12.0,3.0,0.0,1.0,0.0,5.0,1.0,9.0,0.0
divide,11.0,7.0,0.0,0.0,0.0,0.0,2.0,0.0,3.0,0.0
filter,12.0,9.0,3.0,1.0,1.0,0.0,5.0,0.0,3.0,0.0
intersperse,7.0,6.0,7.0,0.0,2.0,1.0,3.0,0.0,5.0,1.0
intersperse,6.0,9.0,2.0,1.0,1.0,0.0,5.0,1.0,3.0,3.0
length,12.0,7.0,1.0,1.0,1.0,0.0,2.0,0.0,7.0,1.0
list-comp,30.0,31.0,29.0,1.0,3.0,5.0,37.0,2.0,21.0,3.0
list-comp,33.0,45.0,28.0,1.0,2.0,0.0,36.0,3.0,9.0,6.0
lookup,9.0,10.0,7.0,2.0,0.0,1.0,6.0,1.0,2.0,4.0
map,12.0,10.0,1.0,1.0,3.0,1.0,2.0,1.0,2.0,0.0
multiply,11.0,15.0,0.0,0.0,1.0,0.0,6.0,1.0,2.0,0.0
nth,7.0,11.0,1.0,0.0,1.0,0.0,2.0,0.0,3.0,0.0
section-5-example,25.0,30.0,28.0,1.0,6.0,0.0,39.0,2.0,12.0,4.0
section-5-example,41.0,43.0,28.0,1.0,3.0,0.0,37.0,1.0,13.0,6.0
section-5-example,25.0,30.0,23.0,1.0,2.0,0.0,36.0,3.0,11.0,7.0
zeros,22.0,15.0,1.0,2.0,1.0,1.0,18.0,0.0,5.0,1.0
zeros,25.0,17.0,2.0,1.0,7.0,1.0,3.0,1.0,5.0,1.0
zipWith,7.0,9.0,5.0,1.0,2.0,0.0,4.0,2.0,3.0,3.0
graphics/background,7.0,8.0,1.0,2.0,4.0,5.0,9.0,1.0,19.0,0.0
graphics/grouped-bar-chart,108.0,143.0,148.0,6.0,1492.0,1.0,247.0,406.0,3997.0,0.0
graphics/line-chart,195.0,231.0,213.0,10.0,2052.0,2.0,452.0,868.0,3877.0,0.0
graphics/stacked-bar-chart,71.0,96.0,86.0,5.0,261.0,0.0,161.0,158.0,208.0,0.0
Test-Name,Graph-Bwd,Graph-BwdAll,Graph-BwdDual,Graph-Eval,Graph-Fwd,Graph-FwdAsDeMorgan,Graph-FwdDual,Trace-Bwd,Trace-Eval,Trace-Fwd
arithmetic,1.0,1.0,0.0,14.0,0.0,5.0,0.0,12.0,13.0,2.0
array,2.0,1.0,0.0,8.0,0.0,4.0,0.0,11.0,14.0,6.0
compose,0.0,1.0,0.0,7.0,0.0,2.0,0.0,9.0,7.0,1.0
dicts,1.0,2.0,1.0,9.0,2.0,3.0,0.0,12.0,7.0,2.0
div-mod-quot-rem,0.0,4.0,0.0,17.0,1.0,5.0,0.0,8.0,13.0,1.0
factorial,1.0,35.0,0.0,19.0,0.0,146.0,0.0,14.0,18.0,5.0
filter,1.0,1.0,0.0,9.0,0.0,2.0,0.0,8.0,13.0,4.0
first-class-constr,0.0,1.0,1.0,13.0,0.0,3.0,0.0,8.0,12.0,3.0
flatten,2.0,2.0,0.0,17.0,0.0,3.0,0.0,10.0,16.0,7.0
foldr_sumSquares,1.0,1.0,0.0,10.0,0.0,3.0,0.0,8.0,12.0,4.0
lexicalScoping,1.0,1.0,0.0,2.0,0.0,3.0,0.0,23.0,17.0,1.0
length,3.0,0.0,0.0,3.0,0.0,3.0,0.0,7.0,6.0,1.0
lookup,2.0,1.0,0.0,26.0,0.0,4.0,0.0,20.0,40.0,6.0
map,1.0,3.0,1.0,27.0,1.0,5.0,1.0,8.0,12.0,2.0
mergeSort,1.0,1.0,0.0,43.0,0.0,6.0,0.0,23.0,32.0,22.0
normalise,1.0,1.0,0.0,5.0,0.0,3.0,0.0,6.0,6.0,4.0
pattern-match,1.0,2.0,0.0,17.0,0.0,5.0,0.0,8.0,13.0,5.0
range,2.0,2.0,0.0,53.0,0.0,12.0,0.0,24.0,32.0,11.0
records,1.0,1.0,0.0,22.0,0.0,4.0,0.0,11.0,14.0,10.0
reverse,2.0,1.0,0.0,6.0,0.0,3.0,0.0,8.0,20.0,3.0
dtw/next-indices,2.0,143.0,0.0,206.0,6.0,741.0,1.0,50.0,130.0,51.0
dtw/cost-matrix,2.0,7.0,1.0,196.0,2.0,118.0,1.0,46.0,119.0,33.0
dtw/matrix-update,0.0,1.0,0.0,7.0,1.0,3.0,0.0,9.0,8.0,2.0
desugar/list-comp-1,1.0,2.0,0.0,51.0,0.0,7.0,0.0,23.0,37.0,15.0
desugar/list-comp-2,1.0,10.0,0.0,208.0,1.0,28.0,0.0,38.0,111.0,44.0
desugar/list-comp-3,1.0,2.0,0.0,47.0,0.0,7.0,0.0,14.0,32.0,10.0
desugar/list-comp-4,1.0,1.0,0.0,20.0,0.0,3.0,0.0,9.0,16.0,3.0
desugar/list-comp-5,0.0,1.0,0.0,15.0,0.0,3.0,0.0,8.0,17.0,3.0
desugar/list-comp-6,1.0,0.0,0.0,1.0,0.0,9.0,0.0,11.0,11.0,1.0
desugar/list-comp-7,1.0,1.0,0.0,16.0,0.0,3.0,0.0,11.0,19.0,3.0
desugar/list-enum,1.0,6.0,0.0,13.0,0.0,7.0,0.0,8.0,15.0,2.0
add,0.0,1.0,0.0,2.0,1.0,1.0,0.0,6.0,6.0,0.0
array/lookup,0.0,1.0,0.0,69.0,0.0,16.0,0.0,15.0,44.0,18.0
array/dims,0.0,1.0,0.0,7.0,0.0,3.0,0.0,9.0,10.0,3.0
convolution/edgeDetect,31.0,44.0,1.0,6144.0,9.0,4437.0,341.0,1144.0,3552.0,1402.0
convolution/emboss,24.0,35.0,0.0,5347.0,2.0,4085.0,334.0,890.0,3084.0,1182.0
convolution/gaussian,26.0,36.0,1.0,4913.0,1.0,3813.0,360.0,828.0,2827.0,1306.0
dict/create,2.0,5.0,0.0,5.0,1.0,6.0,0.0,11.0,30.0,0.0
dict/difference,1.0,1.0,0.0,3.0,0.0,7.0,0.0,6.0,7.0,1.0
dict/disjointUnion,1.0,1.0,0.0,2.0,0.0,3.0,0.0,10.0,6.0,0.0
dict/foldl,2.0,2.0,0.0,46.0,0.0,13.0,0.0,15.0,18.0,5.0
dict/intersectionWith,2.0,1.0,2.0,28.0,1.0,4.0,0.0,26.0,17.0,18.0
dict/fromRecord,0.0,1.0,0.0,1.0,1.0,2.0,0.0,9.0,7.0,0.0
dict/get,0.0,2.0,0.0,3.0,0.0,2.0,0.0,8.0,7.0,1.0
dict/map,1.0,1.0,0.0,11.0,0.0,4.0,0.0,10.0,10.0,3.0
divide,0.0,0.0,0.0,2.0,0.0,4.0,0.0,5.0,13.0,0.0
filter,1.0,1.0,0.0,15.0,0.0,3.0,0.0,13.0,16.0,2.0
intersperse,1.0,1.0,0.0,10.0,1.0,3.0,0.0,8.0,7.0,2.0
intersperse,1.0,2.0,0.0,7.0,0.0,2.0,1.0,7.0,10.0,4.0
length,1.0,1.0,0.0,8.0,0.0,2.0,0.0,6.0,15.0,1.0
list-comp,1.0,2.0,1.0,94.0,2.0,13.0,3.0,28.0,67.0,29.0
list-comp,1.0,1.0,0.0,77.0,1.0,7.0,2.0,24.0,65.0,24.0
lookup,0.0,0.0,1.0,14.0,0.0,3.0,1.0,10.0,14.0,4.0
map,0.0,0.0,0.0,8.0,0.0,3.0,0.0,10.0,8.0,1.0
multiply,1.0,2.0,0.0,1.0,0.0,1.0,0.0,8.0,15.0,0.0
nth,0.0,0.0,0.0,4.0,1.0,3.0,0.0,7.0,18.0,1.0
section-5-example,1.0,3.0,1.0,87.0,1.0,7.0,4.0,25.0,71.0,30.0
section-5-example,1.0,2.0,0.0,83.0,1.0,10.0,2.0,23.0,58.0,25.0
section-5-example,2.0,2.0,0.0,111.0,1.0,9.0,3.0,21.0,62.0,28.0
zeros,1.0,1.0,0.0,4.0,1.0,2.0,0.0,10.0,7.0,2.0
zeros,0.0,0.0,0.0,3.0,0.0,2.0,0.0,5.0,8.0,5.0
zipWith,1.0,2.0,0.0,13.0,0.0,2.0,1.0,9.0,14.0,6.0
graphics/background,2.0,4.0,0.0,12.0,2.0,20.0,0.0,9.0,12.0,3.0
graphics/grouped-bar-chart,6.0,853.0,1.0,526.0,250.0,2585.0,0.0,107.0,294.0,134.0
graphics/line-chart,9.0,1953.0,1.0,799.0,856.0,3744.0,0.0,139.0,443.0,191.0
graphics/stacked-bar-chart,4.0,228.0,0.0,288.0,143.0,189.0,0.0,64.0,173.0,70.0
56 changes: 14 additions & 42 deletions test/Benchmark/Util.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,77 +2,49 @@ module Benchmark.Util where

import Prelude

import Control.Monad.Writer (WriterT, runWriterT)
import Control.Monad.Writer.Class (class MonadWriter, tell)
import Data.Array (intersperse, fromFoldable) as A
import Data.List (fold)
import Data.Map (Map, unionWith, fromFoldable, keys, values)
import Data.Map (Map, singleton, unionWith, fromFoldable, keys, values)
import Effect.Class (class MonadEffect, liftEffect)
import Test.Spec.Microtime (microtime)
import Util (type (×), (×))

data BenchRow = BenchRow TraceRow GraphRow
newtype BenchRow = BenchRow (Map String Number)

newtype BenchAcc = BenchAcc (Array (String × BenchRow))

type WithBenchAcc g a = WriterT BenchAcc g a

runWithBenchAcc :: forall g a. Monad g => WithBenchAcc g a -> g (a × BenchAcc)
runWithBenchAcc = runWriterT

derive newtype instance Semigroup BenchAcc
derive newtype instance Monoid BenchAcc

type TraceRow = Map String Number
-- { tEval :: Number
-- , tBwd :: Number
-- , tFwd :: Number
-- }

type GraphRow = Map String Number

-- { tEval :: Number
-- , tBwd :: Number
-- , tBwdDual :: Number
-- , tBwdAll :: Number
-- , tFwd :: Number
-- , tFwdDual :: Number
-- , tFwdAsDemorgan :: Number
-- }

instance Show BenchAcc where
show (BenchAcc rows) =
fold $ A.intersperse "\n" ([ showHeader ] <> (showRow <$> rows))
where
BenchRow tr_empty gr_empty = mempty
BenchRow empty_row = mempty

showHeader :: String
showHeader =
fold $ A.intersperse "," ([ "Test-Name" ] <> A.fromFoldable (keys tr_empty) <> A.fromFoldable (keys gr_empty))
fold $ A.intersperse "," ([ "Test-Name" ] <> A.fromFoldable (keys empty_row))

showRow :: String × BenchRow -> String
showRow (test_name × (BenchRow trRow grRow)) =
fold $ A.intersperse "," ([ test_name ] <> (show <$> A.fromFoldable (values trRow <> values grRow)))
showRow (test_name × (BenchRow row)) =
fold $ A.intersperse "," ([ test_name ] <> (show <$> A.fromFoldable (values row)))

instance Semigroup BenchRow where
append (BenchRow trRow1 gRow1) (BenchRow trRow2 gRow2) =
BenchRow
(unionWith (+) trRow1 trRow2)
(unionWith (+) gRow1 gRow2)
append (BenchRow row1) (BenchRow row2) = BenchRow (unionWith (+) row1 row2)

instance Monoid BenchRow where
mempty = BenchRow
(fromFoldable [ ("Trace-Eval" × 0.0), ("Trace-Bwd" × 0.0), ("Trace-Fwd" × 0.0) ])
(fromFoldable [ ("Graph-Eval" × 0.0), ("Graph-Bwd" × 0.0), ("Graph-Fwd" × 0.0), ("Graph-BwdDual" × 0.0), ("Graph-BwdAll" × 0.0), ("Graph-FwdDual" × 0.0), ("Graph-FwdAsDeMorgan" × 0.0) ])
(fromFoldable [ ("Trace-Eval" × 0.0), ("Trace-Bwd" × 0.0), ("Trace-Fwd" × 0.0), ("Graph-Eval" × 0.0), ("Graph-Bwd" × 0.0), ("Graph-Fwd" × 0.0), ("Graph-BwdDual" × 0.0), ("Graph-BwdAll" × 0.0), ("Graph-FwdDual" × 0.0), ("Graph-FwdAsDeMorgan" × 0.0) ])

tdiff :: Number -> Number -> Number
tdiff x y = sub y x

preciseTime :: forall m. MonadEffect m => m Number
preciseTime = liftEffect microtime

bench :: forall m a. MonadEffect m => (Unit -> m a) -> m (a × Number)
bench prog = do
bench :: forall m a. MonadEffect m => MonadWriter BenchRow m => String -> (Unit -> m a) -> m a
bench name prog = do
t1 <- preciseTime
a <- prog unit
r <- prog unit
t2 <- preciseTime
pure (a × tdiff t1 t2)
tell (BenchRow $ singleton name (tdiff t1 t2))
pure r
61 changes: 28 additions & 33 deletions test/Util.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,16 +4,18 @@ import Prelude hiding (absurd)

import App.Fig (LinkFigSpec)
import App.Util (Selector)
import Benchmark.Util (BenchRow(..), GraphRow, TraceRow, bench)
import Benchmark.Util (BenchRow(..), bench)
import Control.Monad.Error.Class (class MonadError, class MonadThrow)
import Control.Monad.Writer.Class (class MonadWriter)
import Control.Monad.Writer.Trans (runWriterT)
import Data.Foldable (foldl)
import Data.Int (toNumber)
import Data.List (elem)
import Data.List.Lazy (List, length, replicateM)
import Data.Set (subset)
import Data.String (null)
import Data.Map (fromFoldable, union)
import DataType (dataTypeFor, typeName)
import Data.Tuple (snd)
import Desug (desugGC)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff)
Expand Down Expand Up @@ -49,10 +51,11 @@ test file progCxt tconfig (n × is_bench) = do
gconfig <- initialConfig progCxt
s <- open file
testPretty s
rows <- replicateM n $ do
trRow <- testTrace s gconfig.γ tconfig
grRow <- testGraph s gconfig tconfig is_bench
pure $ BenchRow trRow grRow
rows <- (map snd) <$>
( replicateM n $ runWriterT $ do
testTrace s gconfig.γ tconfig
testGraph s gconfig tconfig is_bench
)
pure $ averageRows rows

testPretty :: forall m a. MonadAff m => MonadError Error m => Ann a => SE.Expr a -> m Unit
Expand All @@ -64,26 +67,26 @@ testPretty s = do
log ("NEW\n" <> show (erase s'))
fail "not equal"

testTrace :: forall m. MonadAff m => MonadError Error m => Raw SE.Expr -> Env Vertex -> TestConfig -> m TraceRow
testTrace :: forall m. MonadAff m => MonadError Error m => MonadWriter BenchRow m => Raw SE.Expr -> Env Vertex -> TestConfig -> m Unit
testTrace s γ { δv, bwd_expect, fwd_expect } = do
-- | Desugaring Galois connections for Unit and Boolean type selections
GC desug <- desugGC s
GC desug𝔹 <- desugGC s

-- | Eval
let e = desug.fwd s
{ gc: GC eval, v } × t_eval <- bench $ \_ ->
{ gc: GC eval, v } <- bench "Trace-Eval" $ \_ ->
traceGC (erase <$> γ) e

-- | Backward
(γ𝔹 × e𝔹) × t_bwd <- bench $ \_ -> do
(γ𝔹 × e𝔹) <- bench "Trace-Bwd" $ \_ -> do
let γ𝔹 × e𝔹 × _ = eval.bwd (δv (botOf v))
pure (γ𝔹 × e𝔹)
let s𝔹 = desug𝔹.bwd e𝔹

-- | Forward (round-tripping)
let e𝔹' = desug𝔹.fwd s𝔹
v𝔹 × t_fwd <- bench $ \_ -> do
v𝔹 <- bench "Trace-Fwd" $ \_ -> do
pure (eval.fwd (γ𝔹 × e𝔹' × top))

-- | Check backward selections
Expand All @@ -94,29 +97,27 @@ testTrace s γ { δv, bwd_expect, fwd_expect } = do
when logging $ log (prettyP v𝔹)
checkPretty "Trace-based value" fwd_expect v𝔹

pure (fromFoldable [ "Trace-Eval" × t_eval, "Trace-Bwd" × t_bwd, "Trace-Fwd" × t_fwd ])

testGraph :: forall m. MonadAff m => MonadError Error m => Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> Boolean -> m GraphRow
testGraph :: forall m. MonadAff m => MonadError Error m => MonadWriter BenchRow m => Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> Boolean -> m Unit
testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do
-- | Desugaring Galois connections for Unit and Boolean type selections
GC desug <- desugGC s
GC desug𝔹 <- desugGC s

-- | Eval
let e = desug.fwd s
{ gc: GC eval, eα, g, vα } × t_eval <- bench $ \_ ->
{ gc: GC eval, eα, g, vα } <- bench "Graph-Eval" $ \_ ->
graphGC gconfig e

-- | Backward
(e𝔹 × αs_out × αs_in) × t_bwd <- bench $ \_ -> do
(e𝔹 × αs_out × αs_in) <- bench "Graph-Bwd" $ \_ -> do
let
αs_out = selectαs (δv (botOf vα)) vα
αs_in = eval.bwd αs_out
pure (select𝔹s eα αs_in × αs_out × αs_in)
let s𝔹 = desug𝔹.bwd e𝔹

-- | Forward (round-tripping)
(v𝔹 × αs_out') × t_fwd <- bench $ \_ -> do
(v𝔹 × αs_out') <- bench "Graph-Fwd" $ \_ -> do
let
αs_out' = eval.fwd αs_in
pure (select𝔹s vα αs_out' × αs_out')
Expand All @@ -130,44 +131,38 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do
αs_out `shouldSatisfy "fwd ⚬ bwd round-tripping property"`
(flip subset αs_out')

let benchmarks = fromFoldable [ "Graph-Eval" × t_eval, "Graph-Bwd" × t_bwd, "Graph-Fwd" × t_fwd ]

if not is_bench then pure benchmarks
else do
-- | Forward (round-tripping) using De Morgan dual
v𝔹_demorgan × t_fwdAsDeMorgan <- bench $ \_ -> do
let
gfwd_demorgan = G.fwdSliceDeMorgan αs_in g
pure (select𝔹s vα (vertices gfwd_demorgan) <#> not)

unless (not is_bench) do
-- | De Morgan dual of backward
e𝔹_dual × t_bwdDual <- bench $ \_ -> do
e𝔹_dual <- bench "Graph-BwdDual" $ \_ -> do
let
αs_out_dual = selectαs (δv (botOf vα)) vα
gbwd_dual = G.bwdSliceDual αs_out_dual g
αs_in_dual = sinks gbwd_dual
pure (select𝔹s eα αs_in_dual)

-- | Backward (all outputs selected)
e𝔹_all × t_bwdAll <- bench $ \_ -> do
e𝔹_all <- bench "Graph-BwdAll" $ \_ -> do
pure (select𝔹s eα $ eval.bwd (vertices vα))

-- | De Morgan dual of forward
v𝔹_dual × t_fwdDual <- bench $ \_ -> do
v𝔹_dual <- bench "Graph-FwdDual" $ \_ -> do
let
gfwd_dual = G.fwdSliceDual αs_in g
pure (select𝔹s vα (vertices gfwd_dual))

-- | Forward (round-tripping) using De Morgan dual
v𝔹_demorgan <- bench "Graph-FwdAsDeMorgan" $ \_ -> do
let
gfwd_demorgan = G.fwdSliceDeMorgan αs_in g
pure (select𝔹s vα (vertices gfwd_demorgan) <#> not)

-- | To avoid unused variables when benchmarking
when logging do
log (prettyP v𝔹_demorgan)
log (prettyP e𝔹_dual)
log (prettyP e𝔹_all)
log (prettyP v𝔹_dual)

pure $ union benchmarks
(fromFoldable [ ("Graph-BwdDual" × t_bwdDual), ("Graph-BwdAll" × t_bwdAll), ("Graph-FwdDual" × t_fwdDual), ("Graph-FwdAsDeMorgan" × t_fwdAsDeMorgan) ])

type TestSpec =
{ file :: String
, fwd_expect :: String
Expand Down Expand Up @@ -212,4 +207,4 @@ averageRows rows =
average $ foldl (<>) mempty rows
where
runs = toNumber $ length rows
average (BenchRow tr gr) = BenchRow (map (_ `div` runs) tr) (map (_ `div` runs) gr)
average (BenchRow row) = BenchRow (map (_ `div` runs) row)

0 comments on commit 115c4a5

Please sign in to comment.