alignment-0.2.0.1: bench/Main.hs
{-# LANGUAGE ScopedTypeVariables #-}
{- HLINT ignore "Avoid NonEmpty.unzip" -}
module Main where
import Control.DeepSeq (NFData, force)
import Criterion.Main
import Data.Alignment
import qualified Data.Alignment as A
import Data.Bifunctor (bimap)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Vector as V
import Prelude (IO, Int, fmap, fst, id, map, snd, take, uncurry, ($), (*), (+), (.))
import qualified Prelude as P
-- Force evaluation to prevent benchmark cheating
forceThis :: (NFData (f (a, b)), NFData (g a), NFData (g b)) => This f g a b -> This f g a b
forceThis (This pairs leftover) = This (force pairs) (force leftover)
-- Benchmark groups
main :: IO ()
main =
defaultMain
[ zipVsBaseBenchmarks,
unzipVsBaseBenchmarks,
alignBenchmarks,
unalignBenchmarks,
roundtripBenchmarks,
transformationBenchmarks,
fusionBenchmarks
]
-- | Benchmark Data.Alignment.zip vs Prelude.zip
zipVsBaseBenchmarks :: Benchmark
zipVsBaseBenchmarks =
bgroup
"zip: Data.Alignment vs Prelude"
[ bgroup
"lists/equal"
[ bench "Prelude.zip 100" $ nf (uncurry P.zip) (listPair 100),
bench "A.zip 100" $ nf (uncurry A.zip) (listPair 100),
bench "Prelude.zip 1000" $ nf (uncurry P.zip) (listPair 1000),
bench "A.zip 1000" $ nf (uncurry A.zip) (listPair 1000),
bench "Prelude.zip 10000" $ nf (uncurry P.zip) (listPair 10000),
bench "A.zip 10000" $ nf (uncurry A.zip) (listPair 10000)
],
bgroup
"lists/unequal"
[ bench "Prelude.zip 100/50" $ nf (\(xs, ys) -> P.zip xs (take 50 ys)) (listPair 100),
bench "A.zip 100/50" $ nf (\(xs, ys) -> A.zip xs (take 50 ys)) (listPair 100),
bench "Prelude.zip 1000/500" $ nf (\(xs, ys) -> P.zip xs (take 500 ys)) (listPair 1000),
bench "A.zip 1000/500" $ nf (\(xs, ys) -> A.zip xs (take 500 ys)) (listPair 1000),
bench "Prelude.zip 10000/5000" $ nf (\(xs, ys) -> P.zip xs (take 5000 ys)) (listPair 10000),
bench "A.zip 10000/5000" $ nf (\(xs, ys) -> A.zip xs (take 5000 ys)) (listPair 10000)
],
bgroup
"vectors"
[ bench "V.zip 100" $ nf (uncurry V.zip) (vectorPair 100),
bench "A.zip 100" $ nf (uncurry A.zip) (vectorPair 100),
bench "V.zip 1000" $ nf (uncurry V.zip) (vectorPair 1000),
bench "A.zip 1000" $ nf (uncurry A.zip) (vectorPair 1000),
bench "V.zip 10000" $ nf (uncurry V.zip) (vectorPair 10000),
bench "A.zip 10000" $ nf (uncurry A.zip) (vectorPair 10000)
],
bgroup
"NonEmpty"
[ bench "NE.zip 100" $ nf (uncurry NE.zip) (nePair 100),
bench "A.zip 100" $ nf (uncurry A.zip) (nePair 100),
bench "NE.zip 1000" $ nf (uncurry NE.zip) (nePair 1000),
bench "A.zip 1000" $ nf (uncurry A.zip) (nePair 1000)
]
]
-- | Benchmark Data.Alignment.unzip vs Prelude.unzip
unzipVsBaseBenchmarks :: Benchmark
unzipVsBaseBenchmarks =
bgroup
"unzip: Data.Alignment vs Prelude"
[ bgroup
"lists"
[ bench "Prelude.unzip 100" $ nf P.unzip (pairList 100),
bench "A.unzip 100" $ nf A.unzip (pairList 100),
bench "Prelude.unzip 1000" $ nf P.unzip (pairList 1000),
bench "A.unzip 1000" $ nf A.unzip (pairList 1000),
bench "Prelude.unzip 10000" $ nf P.unzip (pairList 10000),
bench "A.unzip 10000" $ nf A.unzip (pairList 10000)
],
bgroup
"vectors"
[ bench "V.unzip 100" $ nf V.unzip (V.fromList $ pairList 100),
bench "A.unzip 100" $ nf A.unzip (V.fromList $ pairList 100),
bench "V.unzip 1000" $ nf V.unzip (V.fromList $ pairList 1000),
bench "A.unzip 1000" $ nf A.unzip (V.fromList $ pairList 1000),
bench "V.unzip 10000" $ nf V.unzip (V.fromList $ pairList 10000),
bench "A.unzip 10000" $ nf A.unzip (V.fromList $ pairList 10000)
],
bgroup
"NonEmpty"
[ bench "NE.unzip 100" $ nf NE.unzip (neList 100),
bench "A.unzip 100" $ nf A.unzip (neList 100),
bench "NE.unzip 1000" $ nf NE.unzip (neList 1000),
bench "A.unzip 1000" $ nf A.unzip (neList 1000)
]
]
-- | Benchmark align vs zip for different sizes and structures
alignBenchmarks :: Benchmark
alignBenchmarks =
bgroup
"align (full result with leftovers)"
[ bgroup
"lists"
[ bgroup
"equal length"
[ bench "align 100" $ nf (uncurry alignList) (listPair 100),
bench "align 1000" $ nf (uncurry alignList) (listPair 1000),
bench "align 10000" $ nf (uncurry alignList) (listPair 10000)
],
bgroup
"unequal length"
[ bench "align 100/50" $ nf (\(xs, ys) -> alignList xs (take 50 ys)) (listPair 100),
bench "align 1000/500" $ nf (\(xs, ys) -> alignList xs (take 500 ys)) (listPair 1000)
]
],
bgroup
"vectors"
[ bgroup
"equal length"
[ bench "align 100" $ nf (uncurry alignVec) (vectorPair 100),
bench "align 1000" $ nf (uncurry alignVec) (vectorPair 1000),
bench "align 10000" $ nf (uncurry alignVec) (vectorPair 10000)
]
],
bgroup
"NonEmpty"
[ bench "align 100" $ nf (uncurry alignNE) (nePair 100),
bench "align 1000" $ nf (uncurry alignNE) (nePair 1000)
]
]
where
alignList :: [Int] -> [Int] -> This [] NonEmpty Int Int
alignList = align
alignVec :: V.Vector Int -> V.Vector Int -> This V.Vector NonEmpty Int Int
alignVec = align
alignNE :: NonEmpty Int -> NonEmpty Int -> This NonEmpty NonEmpty Int Int
alignNE = align
-- | Benchmark unalign (recovers full input including leftovers)
unalignBenchmarks :: Benchmark
unalignBenchmarks =
bgroup
"unalign (full recovery)"
[ bgroup
"lists"
[ bench "unalign 100" $ nf unalignList (alignedList 100),
bench "unalign 1000" $ nf unalignList (alignedList 1000),
bench "unalign 10000" $ nf unalignList (alignedList 10000)
],
bgroup
"vectors"
[ bench "unalign 100" $ nf unalignVec (alignedVector 100),
bench "unalign 1000" $ nf unalignVec (alignedVector 1000),
bench "unalign 10000" $ nf unalignVec (alignedVector 10000)
]
]
where
unalignList :: This [] NonEmpty Int Int -> ([Int], [Int])
unalignList = unalign
unalignVec :: This V.Vector NonEmpty Int Int -> (V.Vector Int, V.Vector Int)
unalignVec = unalign
-- | Benchmark roundtrip: zip then unzip, align then unalign
roundtripBenchmarks :: Benchmark
roundtripBenchmarks =
bgroup
"roundtrip"
[ bgroup
"lists"
[ bench "Prelude zip/unzip 100" $ nf (\(xs, ys) -> P.unzip (P.zip xs ys)) (listPair 100),
bench "A zip/unzip 100" $ nf (\(xs, ys) -> A.unzip (A.zip xs ys)) (listPair 100),
bench "align/unalign 100" $ nf (\(xs, ys) -> unalign (align xs ys :: This [] NonEmpty Int Int)) (listPair 100),
bench "Prelude zip/unzip 1000" $ nf (\(xs, ys) -> P.unzip (P.zip xs ys)) (listPair 1000),
bench "A zip/unzip 1000" $ nf (\(xs, ys) -> A.unzip (A.zip xs ys)) (listPair 1000),
bench "align/unalign 1000" $ nf (\(xs, ys) -> unalign (align xs ys :: This [] NonEmpty Int Int)) (listPair 1000)
],
bgroup
"vectors"
[ bench "V zip/unzip 100" $ nf (\(xs, ys) -> V.unzip (V.zip xs ys)) (vectorPair 100),
bench "A zip/unzip 100" $ nf (\(xs, ys) -> A.unzip (A.zip xs ys)) (vectorPair 100),
bench "align/unalign 100" $ nf (\(xs, ys) -> unalign (align xs ys :: This V.Vector NonEmpty Int Int)) (vectorPair 100),
bench "V zip/unzip 1000" $ nf (\(xs, ys) -> V.unzip (V.zip xs ys)) (vectorPair 1000),
bench "A zip/unzip 1000" $ nf (\(xs, ys) -> A.unzip (A.zip xs ys)) (vectorPair 1000),
bench "align/unalign 1000" $ nf (\(xs, ys) -> unalign (align xs ys :: This V.Vector NonEmpty Int Int)) (vectorPair 1000)
]
]
-- | Benchmark transformation operations (map during align/unalign)
transformationBenchmarks :: Benchmark
transformationBenchmarks =
bgroup
"with transformation"
[ bgroup
"lists"
[ bench "map/Prelude.zip/map 1000" $ nf (\(xs, ys) -> let zs = P.zip xs ys in (map ((+ 1) . fst) zs, map ((* 2) . snd) zs)) (listPair 1000),
bench "map/A.zip/map 1000" $ nf (\(xs, ys) -> let zs = A.zip xs ys in (map ((+ 1) . fst) zs, map ((* 2) . snd) zs)) (listPair 1000),
bench "alignWith 1000" $ nf (\(xs, ys) -> alignWith id (+ 1) (* 2) xs ys :: This [] NonEmpty Int Int) (listPair 1000),
bench "Prelude.unzip/map/map 1000" $ nf (bimap (map (+ 1)) (map (* 2)) . P.unzip) (pairList 1000),
bench "A.unzip/map/map 1000" $ nf (bimap (map (+ 1)) (map (* 2)) . A.unzip) (pairList 1000),
bench "unalignWith 1000" $ nf (unalignWith (+ 1) (* 2)) (alignedList 1000)
]
]
-- | Benchmark fusion effectiveness
fusionBenchmarks :: Benchmark
fusionBenchmarks =
bgroup
"fusion"
[ bgroup
"composition"
-- These benchmarks intentionally compare unoptimized vs optimized forms
{- HLINT ignore "Functor law" -}
{- HLINT ignore "Redundant bimap" -}
[ bench "fmap . fmap 1000" $ nf (fmap (* 2) . fmap (+ 1)) (alignedList 1000),
bench "fmap composed 1000" $ nf (fmap ((* 2) . (+ 1))) (alignedList 1000),
bench "bimap . bimap 1000" $ nf (bimap (* 2) (* 3) . bimap (+ 1) (+ 2)) (alignedList 1000),
bench "bimap composed 1000" $ nf (bimap ((* 2) . (+ 1)) ((* 3) . (+ 2))) (alignedList 1000)
],
bgroup
"roundtrip elimination"
[ bench "align/unalign 1000" $ nf (\(xs, ys) -> unalign (align xs ys :: This [] NonEmpty Int Int)) (listPair 1000),
bench "direct 1000" $ nf id (listPair 1000),
bench "alignWith/unalignWith 1000" $ nf (\(xs, ys) -> unalignWith (+ 1) (* 2) (align xs ys :: This [] NonEmpty Int Int)) (listPair 1000),
bench "map/map 1000" $ nf (bimap (map (+ 1)) (map (* 2))) (listPair 1000)
]
]
-- Test data generators
listPair :: Int -> ([Int], [Int])
listPair n = ([1 .. n], [1 .. n])
vectorPair :: Int -> (V.Vector Int, V.Vector Int)
vectorPair n = (V.enumFromN 1 n, V.enumFromN 1 n)
nePair :: Int -> (NonEmpty Int, NonEmpty Int)
nePair n = (1 :| [2 .. n], 1 :| [2 .. n])
pairList :: Int -> [(Int, Int)]
pairList n = [(i, i) | i <- [1 .. n]]
alignedList :: Int -> This [] NonEmpty Int Int
alignedList n = align [1 .. n] [1 .. n]
alignedVector :: Int -> This V.Vector NonEmpty Int Int
alignedVector n = align (V.enumFromN 1 n) (V.enumFromN 1 n)
neList :: Int -> NonEmpty (Int, Int)
neList n = (1, 1) :| [(i, i) | i <- [2 .. n]]