diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 1.0.4 + +* Improve performance of sorting algorithm and its parallelization. Fix huge slow down on + CPUs with at least 16 cores. + # 1.0.3 * Deprecated `indexWith` in favor of `indexAssert` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,11 +9,19 @@ | Language | Github Actions | Coveralls | Gitter.im | |:--------:|:--------------:|:---------:|:---------:| -| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/massiv.svg) | [![Build Status](https://github.com/lehins/massiv/workflows/massiv-CI/badge.svg)](https://github.com/lehins/massiv/actions) | [![Coverage Status](https://coveralls.io/repos/github/lehins/massiv/badge.svg?branch=master)](https://coveralls.io/github/lehins/massiv?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) +| ![GitHub top language][GHL] | [![GA-CI][GA-B]][GA-L] | [![Coveralls][Co-B]][Co-L] | [![Gitter][Gi-B]][Gi-L] +[GHL]: https://img.shields.io/github/languages/top/lehins/massiv.svg +[GA-B]: https://github.com/lehins/massiv/workflows/massiv-CI/badge.svg?branch=master +[GA-L]: https://github.com/lehins/massiv/actions +[Co-B]: https://coveralls.io/repos/github/lehins/massiv/badge.svg?branch=master +[Co-L]: https://coveralls.io/github/lehins/massiv?branch=master +[Gi-B]: https://badges.gitter.im/haskell-massiv/Lobby.svg +[Gi-L]: https://gitter.im/haskell-massiv/Lobby + | Package | Hackage | Nightly | LTS | |:-------------------|:-------:|:-------:|:---:| -| [`massiv`](https://github.com/lehins/massiv/tree/master/massiv)| [![Hackage](https://img.shields.io/hackage/v/massiv.svg)](https://hackage.haskell.org/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/nightly)](https://www.stackage.org/nightly/package/massiv)| [![LTS](https://www.stackage.org/package/massiv-io/badge/lts)](https://www.stackage.org/lts/package/massiv-io)| +| [`massiv`](https://github.com/lehins/massiv/tree/master/massiv)| [![Hackage](https://img.shields.io/hackage/v/massiv.svg)](https://hackage.haskell.org/package/massiv)| [![Nightly](https://www.stackage.org/package/massiv/badge/nightly)](https://www.stackage.org/nightly/package/massiv)| [![LTS](https://www.stackage.org/package/massiv/badge/lts)](https://www.stackage.org/lts/package/massiv)| | [`massiv-test`](https://github.com/lehins/massiv/tree/master/massiv-test)| [![Hackage](https://img.shields.io/hackage/v/massiv-test.svg)](https://hackage.haskell.org/package/massiv-test)| [![Nightly](https://www.stackage.org/package/massiv-test/badge/nightly)](https://www.stackage.org/nightly/package/massiv-test)| [![LTS](https://www.stackage.org/package/massiv-test/badge/lts)](https://www.stackage.org/lts/package/massiv-test)| | [`haskell-scheduler`](https://github.com/lehins/haskell-scheduler)| [![Hackage](https://img.shields.io/hackage/v/scheduler.svg)](https://hackage.haskell.org/package/scheduler)| [![Nightly](https://www.stackage.org/package/scheduler/badge/nightly)](https://www.stackage.org/nightly/package/scheduler)| [![LTS](https://www.stackage.org/package/scheduler/badge/lts)](https://www.stackage.org/lts/package/scheduler)| diff --git a/massiv.cabal b/massiv.cabal --- a/massiv.cabal +++ b/massiv.cabal @@ -1,5 +1,5 @@ name: massiv -version: 1.0.3.0 +version: 1.0.4.0 synopsis: Massiv (Массив) is an Array Library. description: Multi-dimensional Arrays with fusion, stencils and parallel computation. homepage: https://github.com/lehins/massiv @@ -13,15 +13,16 @@ extra-source-files: README.md , CHANGELOG.md cabal-version: >=1.10 -tested-with: GHC == 8.0.2 - , GHC == 8.2.2 - , GHC == 8.4.4 - , GHC == 8.6.5 - , GHC == 8.8.4 - , GHC == 8.10.7 - , GHC == 9.0.2 - , GHC == 9.2.5 - , GHC == 9.4.3 +tested-with: GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.7 + , GHC == 9.4.4 + , GHC == 9.6.1 flag unsafe-checks description: Enable all the bounds checks for unsafe functions at the cost of diff --git a/src/Data/Massiv/Array/Ops/Sort.hs b/src/Data/Massiv/Array/Ops/Sort.hs --- a/src/Data/Massiv/Array/Ops/Sort.hs +++ b/src/Data/Massiv/Array/Ops/Sort.hs @@ -27,11 +27,13 @@ import Control.Monad.IO.Unlift import Control.Monad.Primitive import Control.Scheduler +import Data.Bits (countLeadingZeros) import Data.Massiv.Array.Delayed.Stream import Data.Massiv.Array.Mutable import Data.Massiv.Array.Ops.Transform import Data.Massiv.Core.Common import Data.Massiv.Vector (scatMaybes, sunfoldrN) +import Data.Word (Word64) import System.IO.Unsafe -- | Count number of occurrences of each element in the array. Results will be @@ -192,9 +194,18 @@ -> Scheduler s () -> MVector s r e -> m () -quicksortInternalM_ fLT fEQ scheduler marr = - scheduleWork scheduler $ qsort (numWorkers scheduler) 0 (unSz (sizeOfMArray marr) - 1) +quicksortInternalM_ fLT fEQ scheduler marr + | numWorkers scheduler < 2 || depthPar <= 0 = qsortSeq 0 (k - 1) + | otherwise = qsortPar depthPar 0 (k - 1) where + -- How deep into the search tree should we continue scheduling jobs. Constants below + -- were discovered imperically: + depthPar = min (logNumWorkers + 4) (logSize - 10) + k = unSz (sizeOfMArray marr) + -- We must use log becuase decinding into a tree creates an exponential number of jobs + logNumWorkers = 63 - countLeadingZeros (fromIntegral (numWorkers scheduler) :: Word64) + -- Using many cores on small vectors only makes things slower + logSize = 63 - countLeadingZeros (fromIntegral k :: Word64) ltSwap i j = do ei <- unsafeLinearRead marr i ej <- unsafeLinearRead marr j @@ -212,7 +223,7 @@ _ <- ltSwap hi lo ltSwap mid hi {-# INLINE getPivot #-} - qsort !n !lo !hi = + qsortPar !n !lo !hi = when (lo < hi) $ do p <- getPivot lo hi l <- unsafeUnstablePartitionRegionM marr (`fLT` p) lo (hi - 1) @@ -220,9 +231,16 @@ if n > 0 then do let !n' = n - 1 - scheduleWork scheduler $ qsort n' lo (l - 1) - scheduleWork scheduler $ qsort n' h hi + scheduleWork scheduler $ qsortPar n' lo (l - 1) + scheduleWork scheduler $ qsortPar n' h hi else do - qsort n lo (l - 1) - qsort n h hi + qsortSeq lo (l - 1) + qsortSeq h hi + qsortSeq !lo !hi = + when (lo < hi) $ do + p <- getPivot lo hi + l <- unsafeUnstablePartitionRegionM marr (`fLT` p) lo (hi - 1) + h <- unsafeUnstablePartitionRegionM marr (`fEQ` p) l hi + qsortSeq lo (l - 1) + qsortSeq h hi {-# INLINE quicksortInternalM_ #-} diff --git a/src/Data/Massiv/Core/List.hs b/src/Data/Massiv/Core/List.hs --- a/src/Data/Massiv/Core/List.hs +++ b/src/Data/Massiv/Core/List.hs @@ -37,7 +37,7 @@ import qualified Data.Massiv.Vector.Stream as S import Data.Monoid import Data.Typeable -import GHC.Exts +import GHC.Exts (IsList(..)) import GHC.TypeLits import System.IO.Unsafe (unsafePerformIO) diff --git a/src/Data/Massiv/Vector/Stream.hs b/src/Data/Massiv/Vector/Stream.hs --- a/src/Data/Massiv/Vector/Stream.hs +++ b/src/Data/Massiv/Vector/Stream.hs @@ -833,14 +833,6 @@ toListN = S.foldr (\x (i, xs) -> (i + 1, x : xs)) (0, []) {-# INLINE toListN #-} -sizeHintToBundleSize :: LengthHint -> B.Size -sizeHintToBundleSize = - \case - LengthExact k -> B.Exact (coerce k) - LengthMax k -> B.Max (coerce k) - LengthUnknown -> B.Unknown -{-# INLINE sizeHintToBundleSize #-} - addHint :: (Sz1 -> LengthHint) -> Int -> Int -> LengthHint addHint hint m n | k == coerce sz = hint sz