Skip to content

Commit

Permalink
Revitalise benchmarks
Browse files Browse the repository at this point in the history
  • Loading branch information
@Bodigrim
Bodigrim committed Aug 15, 2023
1 parent 3a5f562 commit ad6e7e8
Show file tree
Hide file tree
Showing 15 changed files with 199 additions and 328 deletions.
20 changes: 9 additions & 11 deletions bench/Bench.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ import Test.Tasty.Bench
import Test.Tasty.Patterns.Printer

import Bench.BitIndex
import Bench.Common
import Bench.GCD
import Bench.Intersection
import Bench.Invert
Expand All @@ -18,27 +19,24 @@ import Bench.Union

main :: IO ()
main = defaultMain $ map (mapLeafBenchmarks addCompare)
[ bgroup "bitIndex" $ map benchBitIndex [5..14]
, bgroup "invert" $ map benchInvert [5..14]
[ bgroup "add" $ map benchAdd [5..14]
, bgroup "bitIndex" $ map benchBitIndex [5..14]
, bgroup "flip" $ map benchRandomFlip [5..14]
, bgroup "gcdExt" $ map benchGCD [5..14]
, bgroup "intersection" $ map benchIntersection [5..14]
, bgroup "invert" $ map benchInvert [5..14]
, bgroup "product" $ map benchProduct [5..14]
, bgroup "productShort" $ map benchProductShort [5..14]
, bgroup "square" $ map benchSquare [5..14]
, bgroup "write" $ map benchRandomWrite [5..14]
, bgroup "flip" $ map benchRandomFlip [5..14]
, bgroup "read" $ map benchRandomRead [5..14]
, bgroup "remainder" $ map benchRemainder [5..14]
, bgroup "remainder" $ map benchRemainder [5..11]
, bgroup "reverse" $ map benchReverse [5..14]
, bgroup "add" $ map benchAdd [5..14]
, bgroup "square" $ map benchSquare [5..14]
, bgroup "sum" $ map benchSum [5..14]
, bgroup "union" $ map benchUnion [5..14]
, bgroup "write" $ map benchRandomWrite [5..14]
]

bitBenchName :: String
bitBenchName = "Bit"

addCompare :: ([String] -> Benchmark -> Benchmark)
addCompare (name : path)
| name /= bitBenchName = bcompare (printAwkExpr (locateBenchmark (bitBenchName : path)))
| name /= labelBit = bcompare (printAwkExpr (locateBenchmark (labelBit : path)))
addCompare _ = id
21 changes: 7 additions & 14 deletions bench/Bench/BitIndex.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,23 +9,16 @@ import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import Test.Tasty.Bench

randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec f k = U.generate n (\i -> f (i == n - 1))
import Bench.Common

allFalseButLast :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
allFalseButLast f k = U.generate n (\i -> f (i == n - 1))
where
n = 1 `shiftL` k

benchBitIndex :: Int -> Benchmark
benchBitIndex k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf bitIndexBit (randomVec Bit k)
, bench "BitTS" $ nf bitIndexBitTS (randomVec TS.Bit k)
, bench "Vector" $ nf elemIndexVector (randomVec id k)
[ bench labelBit $ nf (bitIndex (Bit True)) (allFalseButLast Bit k)
, bench labelBitTS $ nf (TS.bitIndex (TS.Bit True)) (allFalseButLast TS.Bit k)
, bench labelVector $ nf (U.elemIndex True) (allFalseButLast id k)
]

bitIndexBit :: U.Vector Bit -> Maybe Int
bitIndexBit = bitIndex (Bit True)

bitIndexBitTS :: U.Vector TS.Bit -> Maybe Int
bitIndexBitTS = TS.bitIndex (TS.Bit True)

elemIndexVector :: U.Vector Bool -> Maybe Int
elemIndexVector = U.elemIndex True
95 changes: 95 additions & 0 deletions bench/Bench/Common.hs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,95 @@
module Bench.Common
( labelBit
, labelBitTS
, labelVector
, labelIntSet
, labelInteger
, randomBools
, randomBools2
, randomVec
, randomVec2
, randomSet
, randomSet2
, randomInteger
, randomInteger2
, randomIndices
, randomIndicesAndBools
) where

import Data.Bit
import Data.Bits
import qualified Data.IntSet as IS
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import System.Random

labelBit :: String
labelBit = "Vector Bit"

labelBitTS :: String
labelBitTS = "Vector TS.Bit"

labelVector :: String
labelVector = "Vector Bool"

labelIntSet :: String
labelIntSet = "IntSet"

labelInteger :: String
labelInteger = "Integer"

seed1 :: Int
seed1 = 42

seed2 :: Int
seed2 = 123

mkRandomBools :: Int -> [Bool]
mkRandomBools seed = map (> (0 :: Int)) $ randoms $ mkStdGen seed

randomBools :: [Bool]
randomBools = mkRandomBools seed1

randomBools2 :: [Bool]
randomBools2 = mkRandomBools seed2

mkRandomVec :: MU.Unbox a => Int -> (Bool -> a) -> Int -> U.Vector a
mkRandomVec seed f k = U.fromList $ map f $ take n $ mkRandomBools seed
where
n = 1 `shiftL` k

randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec = mkRandomVec seed1

randomVec2 :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec2 = mkRandomVec seed2

mkRandomSet :: Int -> Int -> IS.IntSet
mkRandomSet seed k = IS.fromAscList (map fst (filter snd (zip [0..] (take n (mkRandomBools seed)))))
where
n = 1 `shiftL` k

randomSet :: Int -> IS.IntSet
randomSet = mkRandomSet seed1

randomSet2 :: Int -> IS.IntSet
randomSet2 = mkRandomSet seed2

mkRandomInteger :: Int -> Int -> Integer
mkRandomInteger seed k = toInteger $ toF2Poly $ mkRandomVec seed Bit k

randomInteger :: Int -> Integer
randomInteger = mkRandomInteger seed1

randomInteger2 :: Int -> Integer
randomInteger2 = mkRandomInteger seed2

randomIndices :: [Int]
randomIndices = map fst randomIndicesAndBools

randomIndicesAndBools :: [(Int, Bool)]
randomIndicesAndBools
= map (\x -> if x > 0 then (x, True) else (x .&. maxBound, False))
. randoms
. mkStdGen
$ 42
20 changes: 3 additions & 17 deletions bench/Bench/GCD.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,26 +5,12 @@ module Bench.GCD
import Data.Bit
import qualified Data.Bit.ThreadSafe as TS
import Data.Bits
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import System.Random
import Test.Tasty.Bench

randomBools :: [Bool]
randomBools = map (> (0 :: Int)) $ randoms $ mkStdGen 42

randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec f k = U.fromList $ map f $ take n randomBools
where
n = 1 `shiftL` k

randomVec' :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec' f k = U.fromList $ map f $ take n $ drop n randomBools
where
n = 1 `shiftL` k
import Bench.Common

benchGCD :: Int -> Benchmark
benchGCD k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf (uncurry gcdExt) ( toF2Poly $ randomVec Bit k, toF2Poly $ randomVec' Bit k)
, bench "BitTS" $ nf (uncurry TS.gcdExt) (TS.toF2Poly $ randomVec TS.Bit k, TS.toF2Poly $ randomVec' TS.Bit k)
[ bench labelBit $ nf (uncurry gcdExt) ( toF2Poly $ randomVec Bit k, toF2Poly $ randomVec2 Bit k)
, bench labelBitTS $ nf (uncurry TS.gcdExt) (TS.toF2Poly $ randomVec TS.Bit k, TS.toF2Poly $ randomVec2 TS.Bit k)
]
52 changes: 8 additions & 44 deletions bench/Bench/Intersection.hs
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Avoid lambda" #-}

module Bench.Intersection
( benchIntersection
) where
Expand All @@ -7,53 +10,14 @@ import qualified Data.Bit.ThreadSafe as TS
import Data.Bits
import qualified Data.IntSet as IS
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import System.Random
import Test.Tasty.Bench

randomBools :: [Bool]
randomBools
= map (> (0 :: Int))
. randoms
. mkStdGen
$ 42

randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec f k = U.fromList (map f (take n randomBools))
where
n = 1 `shiftL` k

randomVec2 :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec2 f k = U.fromList (map f (take n $ drop n randomBools))
where
n = 1 `shiftL` k

randomSet :: Int -> IS.IntSet
randomSet k = IS.fromAscList (map fst (filter snd (zip [0..] (take n randomBools))))
where
n = 1 `shiftL` k

randomSet2 :: Int -> IS.IntSet
randomSet2 k = IS.fromAscList (map fst (filter snd (zip [0..] (take n $ drop n randomBools))))
where
n = 1 `shiftL` k
import Bench.Common

benchIntersection :: Int -> Benchmark
benchIntersection k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf (\x -> intersectionBit (randomVec Bit k) x) (randomVec2 Bit k)
, bench "BitTS" $ nf (\x -> intersectionBitTS (randomVec TS.Bit k) x) (randomVec2 TS.Bit k)
, bench "Vector" $ nf (\x -> intersectionVector (randomVec id k) x) (randomVec2 id k)
, bench "IntSet" $ nf (intersectionIntSet (randomSet k)) (randomSet2 k)
[ bench labelBit $ nf (\x -> zipBits (.&.) (randomVec Bit k) x) (randomVec2 Bit k)
, bench labelBitTS $ nf (\x -> TS.zipBits (.&.) (randomVec TS.Bit k) x) (randomVec2 TS.Bit k)
, bench labelVector $ nf (\x -> U.zipWith (&&) (randomVec id k) x) (randomVec2 id k)
, bench labelIntSet $ nf (IS.union (randomSet k)) (randomSet2 k)
]

intersectionBit :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
intersectionBit = zipBits (.&.)

intersectionBitTS :: U.Vector TS.Bit -> U.Vector TS.Bit -> U.Vector TS.Bit
intersectionBitTS = TS.zipBits (.&.)

intersectionVector :: U.Vector Bool -> U.Vector Bool -> U.Vector Bool
intersectionVector = U.zipWith (&&)

intersectionIntSet :: IS.IntSet -> IS.IntSet -> IS.IntSet
intersectionIntSet = IS.union
29 changes: 4 additions & 25 deletions bench/Bench/Invert.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,34 +6,13 @@ import Data.Bit
import qualified Data.Bit.ThreadSafe as TS
import Data.Bits
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import System.Random
import Test.Tasty.Bench

randomBools :: [Bool]
randomBools
= map (> (0 :: Int))
. randoms
. mkStdGen
$ 42

randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec f k = U.fromList (map f (take n randomBools))
where
n = 1 `shiftL` k
import Bench.Common

benchInvert :: Int -> Benchmark
benchInvert k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf invertBit (randomVec Bit k)
, bench "BitTS" $ nf invertBitTS (randomVec TS.Bit k)
, bench "Vector" $ nf invertVector (randomVec id k)
[ bench labelBit $ nf invertBits (randomVec Bit k)
, bench labelBitTS $ nf TS.invertBits (randomVec TS.Bit k)
, bench labelVector $ nf (U.map not) (randomVec id k)
]

invertBit :: U.Vector Bit -> U.Vector Bit
invertBit = invertBits

invertBitTS :: U.Vector TS.Bit -> U.Vector TS.Bit
invertBitTS = TS.invertBits

invertVector :: U.Vector Bool -> U.Vector Bool
invertVector = U.map not
46 changes: 13 additions & 33 deletions bench/Bench/Product.hs
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Avoid lambda" #-}

module Bench.Product
( benchProduct
, benchProductShort
Expand All @@ -8,52 +11,29 @@ import Data.Bit
import qualified Data.Bit.ThreadSafe as TS
import Data.Bits
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import System.Random
import Test.Tasty.Bench

randomBools :: [Bool]
randomBools
= map (> (0 :: Int))
. randoms
. mkStdGen
$ 42

randomVec :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec f k = U.fromList (map f (take n randomBools))
where
n = 1 `shiftL` k

randomVec2 :: MU.Unbox a => (Bool -> a) -> Int -> U.Vector a
randomVec2 f k = U.fromList (map f (take n $ drop n randomBools))
where
n = 1 `shiftL` k

randomInteger :: Int -> Integer
randomInteger k = toInteger $ toF2Poly $ randomVec Bit k

randomInteger2 :: Int -> Integer
randomInteger2 k = toInteger $ toF2Poly $ randomVec2 Bit k
import Bench.Common

benchProduct :: Int -> Benchmark
benchProduct k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x) (toF2Poly $ randomVec2 Bit k)
, bench "BitTS" $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec2 TS.Bit k)
, bench "Integer" $ nf (\x -> binMul (randomInteger k) x) (randomInteger2 k)
[ bench labelBit $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x) (toF2Poly $ randomVec2 Bit k)
, bench labelBitTS $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec2 TS.Bit k)
, bench labelInteger $ nf (\x -> binMul (randomInteger k) x) (randomInteger2 k)
]

benchProductShort :: Int -> Benchmark
benchProductShort k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x) (toF2Poly $ U.take 32 $ randomVec2 Bit k)
, bench "BitTS" $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ U.take 32 $ randomVec2 TS.Bit k)
, bench "Integer" $ nf (\x -> binMul (randomInteger k) x) ((1 `shiftL` 32 - 1) .&. randomInteger2 k)
[ bench labelBit $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x) (toF2Poly $ U.take 32 $ randomVec2 Bit k)
, bench labelBitTS $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ U.take 32 $ randomVec2 TS.Bit k)
, bench labelInteger $ nf (\x -> binMul (randomInteger k) x) ((1 `shiftL` 32 - 1) .&. randomInteger2 k)
]

benchSquare :: Int -> Benchmark
benchSquare k = bgroup (show (1 `shiftL` k :: Int))
[ bench "Bit" $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x) (toF2Poly $ randomVec Bit k)
, bench "BitTS" $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec TS.Bit k)
, bench "Integer" $ nf (\x -> binMul (randomInteger k) x) (randomInteger k)
[ bench labelBit $ nf (\x -> (*) (toF2Poly $ randomVec Bit k) x) (toF2Poly $ randomVec Bit k)
, bench labelBitTS $ nf (\x -> (*) (TS.toF2Poly $ randomVec TS.Bit k) x) (TS.toF2Poly $ randomVec TS.Bit k)
, bench labelInteger $ nf (\x -> binMul (randomInteger k) x) (randomInteger k)
]

binMul :: Integer -> Integer -> Integer
Expand Down
Loading

0 comments on commit ad6e7e8

Please sign in to comment.