semiring-num-1.6.0.0: bench/bench.hs

module Main (main) where

import           Criterion.Main

import           System.Random

import           Control.Monad

import           Data.Semiring

import qualified Data.Vector as Vector

threeInts :: IO (Int,Int,Int)
threeInts = (,,) <$> randomIO <*> randomIO <*> randomIO

int :: IO Int
int = randomIO

sumAtSize :: Int -> Benchmark
sumAtSize n =
    env (replicateM n threeInts) $
    \xs ->
         bgroup (show n) [bench "add" $ nf add xs]

atSizeList :: Int -> Int -> Benchmark
atSizeList n m =
    env ((,) <$> replicateM n int <*> replicateM m int) $
    \xs ->
         bgroup
             (show (n, m))
             [ bench (show n ++ "<.>" ++ show m) (nf (uncurry (<.>)) xs)
             , bench (show m ++ "<.>" ++ show n) (nf (uncurry (flip (<.>))) xs)
             , bench (show n ++ "<+>" ++ show m) (nf (uncurry (<+>)) xs)
             , bench (show m ++ "<+>" ++ show n) (nf (uncurry (flip (<+>))) xs)]

starList :: Int -> Benchmark
starList n = env (replicateM n (pure ())) $ \xs -> bench (show n) (nf (take n . star) xs)

atSizeVec :: Int -> Int -> Benchmark
atSizeVec n m =
    env ((,) <$> Vector.replicateM n int <*> Vector.replicateM m int) $
    \xs ->
         bgroup
             (show (n, m))
             [ bench (show n ++ "<.>" ++ show m) (nf (uncurry (<.>)) xs)
             , bench (show m ++ "<.>" ++ show n) (nf (uncurry (flip (<.>))) xs)
             , bench (show n ++ "<+>" ++ show m) (nf (uncurry (<+>)) xs)
             , bench (show m ++ "<+>" ++ show n) (nf (uncurry (flip (<+>))) xs)]

main :: IO ()
main =
    defaultMain
        [ bgroup "list star" [starList 2000]
        , bgroup "vec" [atSizeVec 4000 2000, atSizeVec 4000 2000]
        , bgroup "list" [atSizeList 400 200, atSizeList 4000 2000]
        , bgroup "add" [sumAtSize 100, sumAtSize 1000]]