acc-0.1: benchmark/Main.hs

module Main where

import Prelude
import Criterion
import Criterion.Main
import qualified Acc
import qualified Data.Foldable as Foldable
import qualified Data.Sequence as Seq
import qualified Data.DList as DList
import qualified Data.Vector as Vector


main =
  defaultMain [
    sumBgroup "1"
      (replicate 1000 1)
      (foldMapToRight)
    ,
    sumBgroup "2"
      (replicate 1000 1)
      (foldMapToLeft)
    ,
    sumBgroup "sum/foldr',foldr'"
      (Vector.fromList (replicate 100 (Vector.fromList (replicate @Int 100 1))))
      (\ singleton -> foldr' (\ a b -> foldr' (mappend . singleton) mempty a <> b) mempty)
    ,
    sumBgroup "sum/foldl',foldl'"
      (Vector.fromList (replicate 100 (Vector.fromList (replicate @Int 100 1))))
      (\ singleton -> foldl' (\ a b -> a <> foldl' (\ a -> mappend a . singleton) mempty b) mempty)
    ,
    bgroup "thousand-elements" [
      bgroup "foldl'" $ let
        !input =
          force $ enumFromTo 0 999 :: [Int]
        in [
          bench "Acc" $ let
            work input =
              let
                acc =
                  foldl' (<>) mempty $ fmap (pure @Acc.Acc) input
                in Foldable.toList acc
            in nf work input
          ,
          bench "Seq" $ let
            work input =
              let
                seq =
                  foldl' (<>) mempty $ fmap Seq.singleton input
                in Foldable.toList seq
            in nf work input
          ,
          bench "DList" $ let
            work input =
              let
                seq =
                  foldl' (<>) mempty $ fmap DList.singleton input
                in Foldable.toList seq
            in nf work input
          ]
      ,
      bgroup "foldr" $ let
        !input =
          force $ enumFromTo 0 999 :: [Int]
        in [
          bench "Acc" $ let
            work input =
              let
                acc =
                  foldr (<>) mempty $ fmap (pure @Acc.Acc) input
                in Foldable.toList acc
            in nf work input
          ,
          bench "Seq" $ let
            work input =
              let
                seq =
                  foldr (<>) mempty $ fmap Seq.singleton input
                in Foldable.toList seq
            in nf work input
          ,
          bench "DList" $ let
            work input =
              let
                seq =
                  foldr (<>) mempty $ fmap DList.singleton input
                in Foldable.toList seq
            in nf work input
          ]
      ,
      bgroup "foldr'" $ let
        !input =
          force $ enumFromTo 0 999 :: [Int]
        in [
          bench "Acc" $ let
            work input =
              let
                acc =
                  foldr' (<>) mempty $ fmap (pure @Acc.Acc) input
                in Foldable.toList acc
            in nf work input
          ,
          bench "Seq" $ let
            work input =
              let
                seq =
                  foldr' (<>) mempty $ fmap Seq.singleton input
                in Foldable.toList seq
            in nf work input
          ,
          bench "DList" $ let
            work input =
              let
                seq =
                  foldr' (<>) mempty $ fmap DList.singleton input
                in Foldable.toList seq
            in nf work input
          ]
      ,
      bgroup "foldr, force intermediate" $ let
        !input =
          force $ enumFromTo 0 999 :: [Int]
        in [
          bench "Acc" $ let
            work input =
              let
                acc =
                  foldr (<>) mempty $ fmap (pure @Acc.Acc) input
                in Foldable.toList $!! acc
            in nf work input
          ,
          bench "Seq" $ let
            work input =
              let
                seq =
                  foldr (<>) mempty $ fmap Seq.singleton input
                in Foldable.toList $!! seq
            in nf work input
          ,
          bench "DList" $ let
            work input =
              let
                seq =
                  foldr (<>) mempty $ fmap DList.singleton input
                in Foldable.toList $!! seq
            in nf work input
          ]
      ,
      bgroup "foldMap" $ let
        !input =
          force $ enumFromTo 0 999 :: [Int]
        in [
          bench "Acc" $ let
            work input =
              let
                acc =
                  foldMap (pure @Acc.Acc) input
                in Foldable.toList acc
            in nf work input
          ,
          bench "Seq" $ let
            work input =
              let
                seq =
                  foldMap Seq.singleton input
                in Foldable.toList seq
            in nf work input
          ,
          bench "DList" $ let
            work input =
              let
                seq =
                  foldMap DList.singleton input
                in Foldable.toList seq
            in nf work input
          ]
      ,
      bgroup "foldMap'" $ let
        !input =
          force $ enumFromTo 0 999 :: [Int]
        in [
          bench "Acc" $ let
            work input =
              let
                acc =
                  foldMap' (pure @Acc.Acc) input
                in Foldable.toList acc
            in nf work input
          ,
          bench "Seq" $ let
            work input =
              let
                seq =
                  foldMap' Seq.singleton input
                in Foldable.toList seq
            in nf work input
          ,
          bench "DList" $ let
            work input =
              let
                seq =
                  foldMap' DList.singleton input
                in Foldable.toList seq
            in nf work input
          ]
      ]
    ,
    bgroup "groups" [
      bgroup "foldl'" [
        bench "acc" $ let
          input :: [Acc.Acc Int]
          !input =
            enumFromTo 0 99 & fmap pure &
            foldl' (<>) mempty &
            replicate 10 &
            force
          work =
            Foldable.toList . foldl' (<>) mempty
          in nf work input
        ,
        bench "seq" $ let
          input :: [Seq Int]
          !input =
            enumFromTo 0 99 & fmap pure &
            foldl' (<>) mempty &
            replicate 10 &
            force
          work =
            Foldable.toList . foldl' (<>) mempty
          in nf work input
        ,
        bench "dlist" $ let
          input :: [DList Int]
          !input =
            enumFromTo 0 99 & fmap pure &
            foldl' (<>) mempty &
            replicate 10 &
            force
          work =
            Foldable.toList . foldl' (<>) mempty
          in nf work input
        ]
      ]
    ]

sumBgroup :: NFData input => String -> input -> (forall f. (Foldable f, Monoid (f Int)) => (Int -> f Int) -> input -> f Int) -> Benchmark
sumBgroup name (force -> !input) build =
  bgroup name [
    sumBench "Acc" (pure @Acc.Acc)
    ,
    sumBench "Seq" Seq.singleton
    ,
    sumBench "DList" DList.singleton
    ,
    sumBench "List" (pure @[])
    ]
  where
    sumBench :: (Foldable f, Monoid (f Int)) => String -> (Int -> f Int) -> Benchmark
    sumBench name singleton =
      bench name (nf (Foldable.sum . build singleton) input)



{-| Best for Acc. -}
{-# NOINLINE foldMapToRight #-}
foldMapToRight :: Monoid m => (a -> m) -> [a] -> m
foldMapToRight pure =
  foldl' (\ a b -> pure b <> a) mempty

{-| Worst for Acc. -}
{-# NOINLINE foldMapToLeft #-}
foldMapToLeft :: Monoid m => (a -> m) -> [a] -> m
foldMapToLeft pure =
  foldl' (\ a b -> a <> pure b) mempty