diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,185 @@ +# 0.3.2 + +* Exported `withMArrayS` +* Switch to pure exception throwing for `read'`, `write'`, `modify'` and `swap'`. `MonadThrow` + constraint prevented those functions to be used in `ST` monad. +* Addition of `quicksort`, `quicksortM_`, `unstablePartitionRegionM` and + `unsafeUnstablePartitionRegionM` + +# 0.3.1 + +* Addition of `rangeStepInclusive'` +* Addition of `flatten` +* `makeLoadArray` has been deprecated into `unsafeMakeLoadArray`. +* A new safe `makeLoadArrayS` has been aded. +* Fix `infix 4` for `(...)` and `(..:)` range functions, so they can be easily composed with + numeric operations +* Addition of `imapSchedulerM_` and `iforSchedulerM_` + +# 0.3.0 + +* Class hierarchy an associated methods: + * `getComp` moved from `Construct` to `Load` + * `Size` class lost array value parameter `e`. `unsafeResize` and `unsafeExtract` became their own + classes +* New classes: + * `Resize` with `unsafeResize` from old `Size`, except with `array` type parameter for + applicability to mutable `MArray`s + * `Extract` with `unsafeExtract` from old `Size` + * `StrideLoad`, child of `Load` +* `ifoldlIO` and related no longer take list of capabilities, but instead respect the inner + computation strategy. For that reason these folds have been removed: `foldlOnP`, `ifoldlOnP`, + `foldrOnP`, `ifoldrOnP` +* `fold` now is just like the one from `Data.Foldable` takes no arguments and requires elements to + be a monoid +* `singleton` does not accept computation strategy any more and creates `Seq` array by default +* New function `empty`. +* `Ragged` functions are no longer exported, until the interface stabilizes and proper + implementation of ragged arrays is in place. +* Partial functions `read'`, `write'` and `swap'` now live in IO and throw proper exceptions. +* `loadArray` is renamed to `loadArrayM` and there is a new separate function (not part of `Load` + class) with the name `loadArray` that actually uses `loadArrayM` +* Moved `unsafeWithPtr` into `Data.Massiv.Array.Unsafe` +* Addition of: + * `unsafeArrayToForeignPtr`, + * `unsafeMArrayToForeignPtr`, + * `unsafeArrayFromForeignPtr`, + * `unsafeArrayFromForeignPtr0`, + * `unsafeMArrayFromForeignPtr`, + * `unsafeMArrayFromForeignPtr0` +* Addition of `castToByteString`, `castFromByteString` +* Addition of `makeUnsafeStencil` +* `Window` now has an `windowUnrollIx2` field. +* Addition of `insertWindow` and `dropWindow` + +# 0.2.8 + +* Fixed a problem where convolution stencil size was not inverted, causing out of bounds memory + read: [#72](https://github.com/lehins/massiv/issues/72) +* Fixed an issue with windowed array where a stencil size is smaller than the array it is applied to +* Fixed incorrect cross-correlation stencil construction + +# 0.2.7 + +* Fixed a serious performance regression in `Stencil`'s `Functor` instance, which was introduced in + version `0.2.3` +* Added type and pattern synonyms `Sz` for future compatibility with version `0.3`. Could be useful + for migration. + +# 0.2.6 + +* Add `expand*` family of functions. +* Long awaited `makeArrayM`/`makeArrayA` and `mapM`/`forM`/`imapM`/`iforM`/`traverseA`/`itraverseA` + alnog with corresponding functions allowing for supplying representation. +* Deprecate `mapP` and `mapP_` in favor of `mapIO` and `mapIO_`, while making latter respect the + `Comp`. +* Addition of a whole collection of mutable operators: + * `mapIO`/`mapIO_`/`imapIO`/`imapIO_`/`forIO`/`forIO_`/`iforIO`/`iforIO_` + * `createArray`/`createArrayST`/`createArrayST_` + * `generateArray`/`generateArrayIO` + * `unfoldlPrim`/`unfoldlPrim_` + * `makeArrayA`, `makeArrayAR` +* Addition of cute synonyms: `(...)` and `(..:)` + +# 0.2.5 + +* Fix for `insertDimension` [#62](https://github.com/lehins/massiv/pull/62) + +# 0.2.4.1 + +* Fix a bug in `zip` functions, where resulting array size would not take into account the size of + one of the input arrays. + + +# 0.2.4 + +* Addition of inner folds: `ifoldlInner`, `foldlInner`, `ifoldrInner` and `foldrInner` +* Addition of functions that can fold over any dimension (`foldlWithin`, `foldlWithin'`, etc.) +* Addition of `ifoldMono` and `ifoldSemi`, thus fixing: + [#54](https://github.com/lehins/massiv/issues/54) +* Improvement over manipulating index dimensions with addition of type level `Dimension n` data type + and functions like `getDimension`, `dropDimension`. +* Addition of `insertDim` and type level `insertDimension` as well as `pullOutDim` and + `pullOutDimension` +* Add partial `extractFromTo'` + +# 0.2.3 + +* Addition of `Profunctor` functions for `Stencil`: `lmapStencil`, `rmapStencil` and `bimapStencil` +* Addition of integration approximation: `Data.Massiv.Array.Numeric.Integral` +* Removed overlapping instances for `DW` in favor of concrete instances. +* Relaxed contraint restrictions on matrix multiplication `(|*|)` and slighly improved performance + with rewrite rules to avoid double transform. + +# 0.2.2 + +* Addition of `withMArray`, `withMArrayST`. +* Improved preformance of matrix multiplication + +# 0.2.1 + +* Addition of `Stride` and related functions `computeWithStride` and `computeWithStrideAs`. +* Addition of `Window` +* Addition of `loadArray` adn `loadArrayWithStride` with default implementations that will become + new loading functions in a subsequent release. `loadArray` will replace `loadS` and `loadP`, which + will be deprecated in the next release and removed in the next major release. Some of this is + discussed in [#41](https://github.com/lehins/massiv/issues/41) +* Addition of various conversion functions: + + * `fromByteString`, `toByteString` and `toBuilder` + * `unwrapArray`, `evalArray`, `unwrapMutableArray`, `evalMutableArray` + * `unwrapNormalFormArray`, `evalNormalFormArray`, `unwrapNormalFormMutableArray`, + `evalNormalFormMutableArray` + +* Fix: `Eq` instance for `Array M ix e` + +# 0.2.0 + +* Fixed type signatures for `convertAs` and `convertProxy` +* Added type constructors for `DW` and `DI` +* `Show` instance for `DW` arrays. +* Addition of `unsafeBackpermuteDW`. +* Breaking changes: + * Create new `Data.Massiv.Array.Stencil.Unsafe` module and move `forStencilUnsafe` into it. + * Rename of rank -> dimensions #25 + * Removal `Eq` and `Ord` instances for `Value` #19 + * Move border resolution to `mapStencil` from `makeStencil`. + * Updated iterators `iterM`, `iterM_`, etc. to have a separate step per dimension. + +# 0.1.6 + +* `Semigroup` and `Monoid` instance for `Value`. +* Addition of `forStencilUnsafe`. +* Fix `minimum` behaving as `maximum`. +* Addition of `foldSemi`. + +# 0.1.5 + +* Fix inverted stencil index calculation [#12](https://github.com/lehins/massiv/issues/12) +* Add support for cross-correlation. + +# 0.1.4 + +* Addition of Monoidal folding `foldMono`. +* Expose `liftArray2`. + +# 0.1.3 + +* Addition of `withPtr` and `unsafeWithPtr` for Storable arrays +* Addition of `computeInto`. +* Exposed `makeWindowedArray`. + +# 0.1.2 + +* Support for GHC-8.4 - instance of `Comp` for `Semigroup` +* Brought back support for GHC-7.10 + +# 0.1.1 + +* Addition of experimental `mapM`, `imapM`, `forM`, `iforM`, `generateM` and `generateLinearM` + functions. Fixes #5 +* Addition of `Ord` instances for some array representations. + +# 0.1.0 + +* Initial Release diff --git a/massiv.cabal b/massiv.cabal --- a/massiv.cabal +++ b/massiv.cabal @@ -1,5 +1,5 @@ name: massiv -version: 0.3.1.0 +version: 0.3.2.0 synopsis: Massiv (Массив) is an Array Library. description: Multi-dimensional Arrays with fusion, stencils and parallel computation. homepage: https://github.com/lehins/massiv @@ -11,6 +11,7 @@ category: Data, Data Structures, Parallelism build-type: Custom extra-source-files: README.md + , CHANGELOG.md cabal-version: >=1.10 flag unsafe-checks @@ -32,6 +33,7 @@ , Data.Massiv.Array.Manifest , Data.Massiv.Array.Manifest.Vector , Data.Massiv.Array.Mutable + , Data.Massiv.Array.Mutable.Algorithms , Data.Massiv.Array.Mutable.Atomic , Data.Massiv.Array.Numeric , Data.Massiv.Array.Numeric.Integral @@ -56,6 +58,7 @@ , Data.Massiv.Array.Ops.Fold.Internal , Data.Massiv.Array.Ops.Map , Data.Massiv.Array.Ops.Slice + , Data.Massiv.Array.Ops.Sort , Data.Massiv.Array.Ops.Transform , Data.Massiv.Array.Stencil.Convolution , Data.Massiv.Array.Stencil.Internal @@ -103,6 +106,7 @@ , Data.Massiv.Array.Ops.ConstructSpec , Data.Massiv.Array.Ops.FoldSpec , Data.Massiv.Array.Ops.SliceSpec + , Data.Massiv.Array.Ops.SortSpec , Data.Massiv.Array.Ops.TransformSpec , Data.Massiv.Array.Ops.MapSpec , Data.Massiv.Array.StencilSpec diff --git a/src/Data/Massiv/Array.hs b/src/Data/Massiv/Array.hs --- a/src/Data/Massiv/Array.hs +++ b/src/Data/Massiv/Array.hs @@ -118,6 +118,8 @@ , module Data.Massiv.Array.Ops.Transform -- * Slicing , module Data.Massiv.Array.Ops.Slice + -- * Sorting + , quicksort -- * Conversion , module Data.Massiv.Array.Manifest.List -- * Mutable @@ -143,6 +145,7 @@ import Data.Massiv.Array.Ops.Fold import Data.Massiv.Array.Ops.Map import Data.Massiv.Array.Ops.Slice +import Data.Massiv.Array.Ops.Sort (quicksort) import Data.Massiv.Array.Ops.Transform import Data.Massiv.Array.Stencil import Data.Massiv.Core diff --git a/src/Data/Massiv/Array/Mutable.hs b/src/Data/Massiv/Array/Mutable.hs --- a/src/Data/Massiv/Array/Mutable.hs +++ b/src/Data/Massiv/Array/Mutable.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -23,7 +24,7 @@ , modify' , swap , swap' - -- ** Operate over `MArray` + -- ** Operations on @MArray@ -- *** Immutable conversion , new , thaw @@ -62,6 +63,7 @@ , iforLinearPrimM_ -- *** Modify , withMArray + , withMArrayS , withMArrayST -- *** Initialize , initialize @@ -75,9 +77,11 @@ , loadArrayS ) where -import Control.Scheduler +-- TODO: add fromListM, et al. + import Control.Monad (unless) import Control.Monad.ST +import Control.Scheduler import Data.Massiv.Core.Common import Prelude hiding (mapM, read) @@ -677,7 +681,9 @@ return acc' {-# INLINE unfoldlPrimM #-} - +--TODO: in 0.4.0: +-- * forPrimM_ does not modify each element, but simply iterates over +-- * forPrimM - does what forPrimM_ does now. -- | Sequentially loop over a mutable array while modifying each element with an action. -- -- @since 0.3.0 @@ -704,11 +710,11 @@ iforLinearPrimM_ marr f = loopM_ 0 (< totalElem (msize marr)) (+ 1) (unsafeLinearModify marr f) {-# INLINE iforLinearPrimM_ #-} - +-- FIXME: supply Scheduler instead of numWorkers and schedule action -- | Create a copy of a pure array, mutate it in place and return its frozen version. The big -- difference between `withMArrayS` is that it's not only gonna respect the computation strategy --- supplied to it, but it will also pass extra argumens to the action that suppose to modify the --- mutable copy of the source array. These two extra arguments are: +-- supplied to it while making a copy, but it will also pass extra argumens to the action that +-- suppose to modify the mutable copy of the source array. These two extra arguments are: -- -- * Number of capabilities derived from the `Comp`utation strategy of the array. -- @@ -735,7 +741,7 @@ -- benefit over doing a manual `thawS` followed by a `freezeS` is that an array will be only copied -- once. -- --- @since 0.3.0 +-- @since 0.3.2 withMArrayS :: (Mutable r ix e, PrimMonad m) => Array r ix e @@ -762,6 +768,8 @@ -- | /O(1)/ - Lookup an element in the mutable array. Returns `Nothing` when index is out of bounds. +-- +-- @since 0.1.0 read :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m (Maybe e) read marr ix = @@ -771,14 +779,14 @@ {-# INLINE read #-} --- | /O(1)/ - Same as `read`, but lives in IO and throws `IndexOutOfBoundsException` on invalid --- index. -read' :: (Mutable r ix e, MonadThrow m, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e -read' marr ix = do - mval <- read marr ix - case mval of - Just e -> pure e - Nothing -> throwM $ IndexOutOfBoundsException (msize marr) ix +-- | /O(1)/ - Same as `read`, but throws `IndexOutOfBoundsException` on an invalid index. +-- +-- @since 0.1.0 +read' :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> m e +read' marr ix = + read marr ix >>= \case + Just e -> pure e + Nothing -> throw $ IndexOutOfBoundsException (msize marr) ix {-# INLINE read' #-} @@ -787,21 +795,25 @@ write :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m Bool write marr ix e = if isSafeIndex (msize marr) ix - then unsafeWrite marr ix e >> return True - else return False + then unsafeWrite marr ix e >> pure True + else pure False {-# INLINE write #-} -- | /O(1)/ - Same as `write`, but lives in IO and throws `IndexOutOfBoundsException` on invalid -- index. +-- +-- @since 0.1.0 write' :: - (Mutable r ix e, MonadThrow m, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () -write' marr ix e = write marr ix e >>= (`unless` throwM (IndexOutOfBoundsException (msize marr) ix)) + (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> e -> m () +write' marr ix e = write marr ix e >>= (`unless` throw (IndexOutOfBoundsException (msize marr) ix)) {-# INLINE write' #-} - +-- TODO: switch to `... -> m (Maybe e)` -- | /O(1)/ - Modify an element in the cell of a mutable array with a supplied function. Returns -- `False` when index is out of bounds. +-- +-- @since 0.1.0 modify :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> e) -> ix -> m Bool modify marr f ix = if isSafeIndex (msize marr) ix @@ -814,15 +826,19 @@ -- | /O(1)/ - Same as `modify`, but throws an error if index is out of bounds. -modify' :: (Mutable r ix e, MonadThrow m, PrimMonad m) => +-- +-- @since 0.1.0 +modify' :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> (e -> e) -> ix -> m () modify' marr f ix = - modify marr f ix >>= (`unless` throwM (IndexOutOfBoundsException (msize marr) ix)) + modify marr f ix >>= (`unless` throw (IndexOutOfBoundsException (msize marr) ix)) {-# INLINE modify' #-} -- | /O(1)/ - Swap two elements in a mutable array by supplying their indices. Returns `False` when -- either one of the indices is out of bounds. +-- +-- @since 0.1.0 swap :: (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m Bool swap marr ix1 ix2 = do let sz = msize marr @@ -837,12 +853,13 @@ -- | /O(1)/ - Same as `swap`, but throws an `IndexOutOfBoundsException` on invalid indices. +-- +-- @since 0.1.0 swap' :: - (Mutable r ix e, MonadThrow m, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () + (Mutable r ix e, PrimMonad m) => MArray (PrimState m) r ix e -> ix -> ix -> m () swap' marr ix1 ix2 = swap marr ix1 ix2 >>= (`unless` if isSafeIndex (msize marr) ix1 - then throwM $ IndexOutOfBoundsException (msize marr) ix2 - else throwM $ IndexOutOfBoundsException (msize marr) ix1) + then throw $ IndexOutOfBoundsException (msize marr) ix2 + else throw $ IndexOutOfBoundsException (msize marr) ix1) {-# INLINE swap' #-} - diff --git a/src/Data/Massiv/Array/Mutable/Algorithms.hs b/src/Data/Massiv/Array/Mutable/Algorithms.hs new file mode 100644 --- /dev/null +++ b/src/Data/Massiv/Array/Mutable/Algorithms.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +-- | +-- Module : Data.Massiv.Array.Mutable.Algorithms +-- Copyright : (c) Alexey Kuleshevich 2019 +-- License : BSD3 +-- Maintainer : Alexey Kuleshevich +-- Stability : experimental +-- Portability : non-portable +-- +module Data.Massiv.Array.Mutable.Algorithms + ( quicksortM_ + , unstablePartitionM + ) where + +import Data.Massiv.Array.Ops.Sort +import Data.Massiv.Core.Common + + +-- | Partition elements of the supplied mutable vector according to the predicate. +-- +-- ==== __Example__ +-- +-- >>> import Data.Massiv.Array as A +-- >>> import Data.Massiv.Array.Mutable.Algorithms +-- >>> m <- thaw ([2,1,50,10,20,8] :: Array P Ix1 Int) +-- >>> unstablePartitionM m (<= 10) +-- 4 +-- >>> freeze Seq m +-- Array P Seq (Sz1 6) +-- [ 2, 1, 8, 10, 20, 50 ] +-- +-- @since 0.3.2 +unstablePartitionM :: + forall r e m. (Mutable r Ix1 e, PrimMonad m) + => MArray (PrimState m) r Ix1 e + -> (e -> Bool) -- ^ Predicate + -> m Ix1 +unstablePartitionM marr f = unsafeUnstablePartitionRegionM marr f 0 (unSz (msize marr) - 1) diff --git a/src/Data/Massiv/Array/Ops/Sort.hs b/src/Data/Massiv/Array/Ops/Sort.hs new file mode 100644 --- /dev/null +++ b/src/Data/Massiv/Array/Ops/Sort.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +-- | +-- Module : Data.Massiv.Array.Ops.Sort +-- Copyright : (c) Alexey Kuleshevich 2018-2019 +-- License : BSD3 +-- Maintainer : Alexey Kuleshevich +-- Stability : experimental +-- Portability : non-portable +-- +module Data.Massiv.Array.Ops.Sort + ( quicksort + , quicksortM_ + , unsafeUnstablePartitionRegionM + ) where + +import Control.Monad (when) +import Control.Scheduler +import Data.Massiv.Array.Mutable +import Data.Massiv.Core.Common +import System.IO.Unsafe + +-- | Partition a segment of a vector. Starting and ending indices are unchecked. +-- +-- @since 0.3.2 +unsafeUnstablePartitionRegionM :: + forall r e m. (Mutable r Ix1 e, PrimMonad m) + => MArray (PrimState m) r Ix1 e + -> (e -> Bool) + -> Ix1 -- ^ Start index of the region + -> Ix1 -- ^ End index of the region + -> m Ix1 +unsafeUnstablePartitionRegionM marr f start end = fromLeft start (end + 1) + where + fromLeft i j + | i == j = pure i + | otherwise = do + x <- unsafeRead marr i + if f x + then fromLeft (i + 1) j + else fromRight i (j - 1) + fromRight i j + | i == j = pure i + | otherwise = do + x <- unsafeRead marr j + if f x + then do + unsafeWrite marr j =<< unsafeRead marr i + unsafeWrite marr i x + fromLeft (i + 1) j + else fromRight i (j - 1) +{-# INLINE unsafeUnstablePartitionRegionM #-} + + +-- | This is an implementation of [Quicksort](https://en.wikipedia.org/wiki/Quicksort), which is an +-- efficient, but unstable sort that uses Median-of-three for pivot choosing, as such it performs +-- very well not only for random values, but also for common edge cases like already sorted, +-- reversed sorted and arrays with many duplicate elements. It will also respect the computation +-- strategy and will result in a nice speed up for systems with multiple CPUs. +-- +-- @since 0.3.2 +quicksort :: + (Mutable r Ix1 e, Ord e) => Array r Ix1 e -> Array r Ix1 e +quicksort arr = + unsafePerformIO $ + withMArray arr (\n s -> quicksortM_ (trivialScheduler_ {numWorkers = n, scheduleWork = s})) +{-# INLINE quicksort #-} + +-- | Mutable version of `quicksort` +-- +-- @since 0.3.2 +quicksortM_ :: + (Ord e, Mutable r Ix1 e, PrimMonad m) + => Scheduler m () + -> MArray (PrimState m) r Ix1 e + -> m () +quicksortM_ scheduler marr = + scheduleWork scheduler $ qsort (numWorkers scheduler) 0 (unSz (msize marr) - 1) + where + leSwap i j = do + ei <- unsafeRead marr i + ej <- unsafeRead marr j + if ei < ej + then do + unsafeWrite marr i ej + unsafeWrite marr j ei + pure ei + else pure ej + {-# INLINE leSwap #-} + getPivot lo hi = do + let !mid = (hi + lo) `div` 2 + _ <- leSwap mid lo + _ <- leSwap hi lo + leSwap mid hi + {-# INLINE getPivot #-} + qsort !n !lo !hi = + when (lo < hi) $ do + p <- getPivot lo hi + l <- unsafeUnstablePartitionRegionM marr (< p) lo (hi - 1) + h <- unsafeUnstablePartitionRegionM marr (== p) l hi + if n > 0 + then do + let !n' = n - 1 + scheduleWork scheduler $ qsort n' lo (l - 1) + scheduleWork scheduler $ qsort n' h hi + else do + qsort n lo (l - 1) + qsort n h hi +{-# INLINE quicksortM_ #-} diff --git a/src/Data/Massiv/Array/Unsafe.hs b/src/Data/Massiv/Array/Unsafe.hs --- a/src/Data/Massiv/Array/Unsafe.hs +++ b/src/Data/Massiv/Array/Unsafe.hs @@ -61,6 +61,8 @@ , unsafeAtomicOrIntArray , unsafeAtomicXorIntArray , unsafeCasIntArray + -- ** Other operations + , unsafeUnstablePartitionRegionM ) where import Data.Massiv.Array.Delayed.Pull (D) @@ -70,6 +72,7 @@ import Data.Massiv.Core.Common import Data.Massiv.Core.Index.Internal (Sz(SafeSz)) import Data.Massiv.Core.Index.Stride (Stride(SafeStride)) +import Data.Massiv.Array.Ops.Sort (unsafeUnstablePartitionRegionM) unsafeBackpermute :: (Source r' ix' e, Index ix) => Sz ix -> (ix -> ix') -> Array r' ix' e -> Array D ix e diff --git a/tests/Data/Massiv/Array/Ops/SortSpec.hs b/tests/Data/Massiv/Array/Ops/SortSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Data/Massiv/Array/Ops/SortSpec.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +module Data.Massiv.Array.Ops.SortSpec (spec) where + +import Data.List as L +import Data.Massiv.CoreArbitrary as A + + +prop_IsSorted :: (b -> b) -> ([Int] -> b) -> (b -> [Int]) -> [Int] -> Property +prop_IsSorted sortWith from to xs = + to (sortWith (from xs)) === sort xs + +spec :: Spec +spec = + describe "QuickSort" $ do + it "Seq" $ property $ prop_IsSorted (quicksort @P) (A.fromList Seq) A.toList + it "Par" $ property $ prop_IsSorted (quicksort @P) (A.fromList (ParN 4)) A.toList diff --git a/tests/Data/Massiv/Array/Ops/TransformSpec.hs b/tests/Data/Massiv/Array/Ops/TransformSpec.hs --- a/tests/Data/Massiv/Array/Ops/TransformSpec.hs +++ b/tests/Data/Massiv/Array/Ops/TransformSpec.hs @@ -69,6 +69,22 @@ describe "Sequence" $ do it "ConsSnoc" $ property prop_ConsSnoc it "UnconsUnsnoc" $ property prop_UnconsUnsnoc + describe "zoomWithGrid" $ do + it "Ix1" $ property (prop_zoomWithGridStrideCompute @Ix1) + it "Ix2" $ property (prop_zoomWithGridStrideCompute @Ix2) + it "Ix3" $ property (prop_zoomWithGridStrideCompute @Ix3) + it "Ix4" $ property (prop_zoomWithGridStrideCompute @Ix4) + +prop_zoomWithGridStrideCompute :: (Show (Array P ix Int), Index ix) => Array D ix Int -> Stride ix -> Int -> Property +prop_zoomWithGridStrideCompute arr stride defVal = + (computeWithStrideAs P stride' arr' === + A.replicate Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal) .&&. + (computeWithStrideAs P stride' (extract' (pureIndex 1) sz' arr') === compute arr) + where + arr' = computeAs P (zoomWithGrid defVal stride arr) + sz' = Sz (liftIndex (subtract 1) $ unSz (size arr')) + stride' = Stride (liftIndex (+ 1) $ unStride stride) + prop_UnconsUnsnoc :: Array D Ix1 Int -> Bool -> Property prop_UnconsUnsnoc arr unconsFirst =