Skip to content

Commit 9a7dc1b

Browse files
tbagrel1tbagrel1
authored
Merge pull request #477 from tweag/tbagrel1/quicksort-perf-bench
Add Quicksort benchmark and export benchmark results as an artifact
2 parents 95d54d1 + b53b28a commit 9a7dc1b

File tree

8 files changed

+110
-30
lines changed

8 files changed

+110
-30
lines changed

‎.github/workflows/ci.yaml

+15-4
Original file line numberDiff line numberDiff line change
@@ -33,13 +33,24 @@ jobs:
3333
- name: Update Cabal's database
3434
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal update"
3535
- name: Build Cabal's dependencies
36-
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --allow-newer --disable-tests --disable-benchmarks --dependencies-only"
36+
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --dependencies-only"
3737
- name: Build
38-
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build --allow-newer --disable-tests --disable-benchmarks"
38+
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build"
3939
- name: Haddock
40-
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal --allow-newer haddock"
40+
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal haddock"
4141
- name: cabal-docspec
42-
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run cabal-docspec
42+
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal-docspec"
43+
- name: Build benchmarks
44+
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal build linear-base:bench:bench"
45+
- name: Run benchmarks
46+
run: nix-shell --arg ghcVersion '"${{ matrix.ghc-version }}"' --arg installHls 'false' --pure --run "cabal bench 2>&1 | tee benchmark_ghc${{ matrix.ghc-version }}.txt"
47+
- name: Upload benchmark results
48+
uses: actions/upload-artifact@v3
49+
with:
50+
name: linear-base_benchmarks_ghc${{ matrix.ghc-version }}
51+
path: |
52+
benchmark_ghc${{ matrix.ghc-version }}.txt
53+
retention-days: 90
4354

4455
ormolu:
4556
name: check formatting with ormolu

‎bench/Data/Mutable/Quicksort.hs

+40
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
{-# LANGUAGE NumericUnderscores #-}
2+
3+
module Data.Mutable.Quicksort (benchmarks) where
4+
5+
import Control.DeepSeq (force)
6+
import Control.Exception (evaluate)
7+
import Data.List (sort)
8+
import Simple.Quicksort (quicksortUsingArray, quicksortUsingList)
9+
import System.Random
10+
import Test.Tasty.Bench
11+
12+
-- Follows thread from https://discourse.haskell.org/t/linear-haskell-quicksort-performance/10280
13+
14+
gen :: StdGen
15+
gen = mkStdGen 4541645642
16+
17+
randomListBuilder :: Int -> IO [Int]
18+
randomListBuilder size = evaluate $ force $ take size (randoms gen :: [Int])
19+
20+
sizes :: [Int]
21+
sizes = [1_000, 50_000, 1_000_000]
22+
23+
benchmarks :: Benchmark
24+
benchmarks =
25+
bgroup
26+
"quicksort"
27+
( ( \size ->
28+
env (randomListBuilder size) $ \randomList ->
29+
bgroup
30+
("size " ++ (show size))
31+
[ bench "quicksortUsingArray" $
32+
nf quicksortUsingArray randomList,
33+
bench "quicksortUsingList" $
34+
nf quicksortUsingList randomList,
35+
bench "sortStdLib" $
36+
nf sort randomList
37+
]
38+
)
39+
<$> sizes
40+
)

‎bench/Main.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,13 @@ module Main where
22

33
import qualified Data.Mutable.Array as Array
44
import qualified Data.Mutable.HashMap as HashMap
5+
import qualified Data.Mutable.Quicksort as Quicksort
56
import Test.Tasty.Bench (defaultMain)
67

78
main :: IO ()
89
main = do
910
defaultMain
1011
[ Array.benchmarks,
11-
HashMap.benchmarks
12+
HashMap.benchmarks,
13+
Quicksort.benchmarks
1214
]

‎cabal.project

+5
Original file line numberDiff line numberDiff line change
@@ -1 +1,6 @@
11
packages: *.cabal
2+
3+
tests: True
4+
benchmarks: True
5+
allow-newer: all
6+
index-state: 2024-09-13T13:31:57Z

‎examples/Simple/Quicksort.hs

+27-16
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,10 @@
11
{-# LANGUAGE LinearTypes #-}
22
{-# LANGUAGE NoImplicitPrelude #-}
33

4+
-- Uncomment the line below to observe the generated (optimised) Core. It will
5+
-- land in a file named “Quicksort.dump-simpl”
6+
-- {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -dsuppress-uniques #-}
7+
48
-- | This module implements quicksort with mutable arrays from linear-base
59
module Simple.Quicksort where
610

@@ -13,15 +17,22 @@ import Prelude.Linear hiding (partition)
1317
-- # Quicksort
1418
-------------------------------------------------------------------------------
1519

16-
quickSort :: [Int] -> [Int]
17-
quickSort xs = unur $ Array.fromList xs $ Array.toList . arrQuicksort
20+
quicksortUsingList :: (Ord a) => [a] -> [a]
21+
quicksortUsingList [] = []
22+
quicksortUsingList (x : xs) = quicksortUsingList ltx ++ x : quicksortUsingList gex
23+
where
24+
ltx = [y | y <- xs, y < x]
25+
gex = [y | y <- xs, y >= x]
26+
27+
quicksortUsingArray :: (Ord a) => [a] -> [a]
28+
quicksortUsingArray xs = unur $ Array.fromList xs $ Array.toList . quicksortArray
1829

19-
arrQuicksort :: Array Int %1 -> Array Int
20-
arrQuicksort arr =
30+
quicksortArray :: (Ord a) => Array a %1 -> Array a
31+
quicksortArray arr =
2132
Array.size arr
2233
& \(Ur len, arr1) -> go 0 (len - 1) arr1
2334

24-
go :: Int -> Int -> Array Int %1 -> Array Int
35+
go :: (Ord a) => Int -> Int -> Array a %1 -> Array a
2536
go lo hi arr
2637
| lo >= hi = arr
2738
| otherwise =
@@ -39,23 +50,23 @@ go lo hi arr
3950
-- @arr'[j] > pivot@ for @ix < j <= hi@,
4051
-- @arr'[k] = arr[k]@ for @k < lo@ and @k > hi@, and
4152
-- @arr'@ is a permutation of @arr@.
42-
partition :: Array Int %1 -> Int -> Int -> Int -> (Array Int, Ur Int)
43-
partition arr pivot lx rx
44-
| (rx < lx) = (arr, Ur (lx - 1))
53+
partition :: (Ord a) => Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)
54+
partition arr pivot lo hi
55+
| (hi < lo) = (arr, Ur (lo - 1))
4556
| otherwise =
46-
Array.read arr lx
57+
Array.read arr lo
4758
& \(Ur lVal, arr1) ->
48-
Array.read arr1 rx
59+
Array.read arr1 hi
4960
& \(Ur rVal, arr2) -> case (lVal <= pivot, pivot < rVal) of
50-
(True, True) -> partition arr2 pivot (lx + 1) (rx - 1)
51-
(True, False) -> partition arr2 pivot (lx + 1) rx
52-
(False, True) -> partition arr2 pivot lx (rx - 1)
61+
(True, True) -> partition arr2 pivot (lo + 1) (hi - 1)
62+
(True, False) -> partition arr2 pivot (lo + 1) hi
63+
(False, True) -> partition arr2 pivot lo (hi - 1)
5364
(False, False) ->
54-
swap arr2 lx rx
55-
& \arr3 -> partition arr3 pivot (lx + 1) (rx - 1)
65+
swap arr2 lo hi
66+
& \arr3 -> partition arr3 pivot (lo + 1) (hi - 1)
5667

5768
-- | @swap a i j@ exchanges the positions of values at @i@ and @j@ of @a@.
58-
swap :: (HasCallStack) => Array Int %1 -> Int -> Int -> Array Int
69+
swap :: (HasCallStack) => Array a %1 -> Int -> Int -> Array a
5970
swap arr i j =
6071
Array.read arr i
6172
& \(Ur ival, arr1) ->

‎linear-base.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -219,6 +219,7 @@ benchmark bench
219219
other-modules:
220220
Data.Mutable.HashMap
221221
Data.Mutable.Array
222+
Data.Mutable.Quicksort
222223
default-language: Haskell2010
223224
build-depends:
224225
base,

‎test-examples/Main.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
module Main where
22

33
import Test.Foreign (foreignGCTests)
4-
import Test.Simple.Quicksort (quickSortTests)
4+
import Test.Simple.Quicksort (quicksortTests)
55
import Test.Tasty
66

77
main :: IO ()
@@ -12,5 +12,5 @@ allTests =
1212
testGroup
1313
"All tests"
1414
[ foreignGCTests,
15-
quickSortTests
15+
quicksortTests
1616
]

‎test-examples/Test/Simple/Quicksort.hs

+17-7
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,29 @@
11
{-# LANGUAGE OverloadedStrings #-}
22

3-
module Test.Simple.Quicksort (quickSortTests) where
3+
module Test.Simple.Quicksort (quicksortTests) where
44

55
import Data.List (sort)
66
import Hedgehog
77
import qualified Hedgehog.Gen as Gen
88
import qualified Hedgehog.Range as Range
9-
import Simple.Quicksort (quickSort)
9+
import Simple.Quicksort (quicksortUsingArray, quicksortUsingList)
1010
import Test.Tasty
1111
import Test.Tasty.Hedgehog (testPropertyNamed)
1212

13-
quickSortTests :: TestTree
14-
quickSortTests = testPropertyNamed "quicksort sorts" "testQuicksort" testQuicksort
13+
quicksortTests :: TestTree
14+
quicksortTests =
15+
testGroup
16+
"quicksort tests"
17+
[ testPropertyNamed "sort xs === quicksortUsingArray xs" "testQuicksortUsingArray" testQuicksortUsingArray,
18+
testPropertyNamed "sort xs === quicksortUsingList xs" "testQuicksortUsingList" testQuicksortUsingList
19+
]
1520

16-
testQuicksort :: Property
17-
testQuicksort = property $ do
21+
testQuicksortUsingArray :: Property
22+
testQuicksortUsingArray = property $ do
1823
xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int $ Range.linear 0 100)
19-
sort xs === quickSort xs
24+
sort xs === quicksortUsingArray xs
25+
26+
testQuicksortUsingList :: Property
27+
testQuicksortUsingList = property $ do
28+
xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int $ Range.linear 0 100)
29+
sort xs === quicksortUsingList xs

0 commit comments

Comments
 (0)