diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,13 @@ +# 0.3.5 + +* Fix and export `guardNumberOfElements` +* `Eq` instances for `IndexException` and `SizeException` +* Fix `upsample` implementation and improve its performance. +* Addition of `deleteRegionM`, `deleteRowsM` and `deleteColumnsM` + # 0.3.4 -* Use the the new stateful workers feature of `schdeuler-1.4.0` +* Use the the new stateful workers feature of `scheduler-1.4.0` * Addition of: * `randomArrayS` * `randomArrayWS` diff --git a/massiv.cabal b/massiv.cabal --- a/massiv.cabal +++ b/massiv.cabal @@ -1,5 +1,5 @@ name: massiv -version: 0.3.4.0 +version: 0.3.5.0 synopsis: Massiv (Массив) is an Array Library. description: Multi-dimensional Arrays with fusion, stencils and parallel computation. homepage: https://github.com/lehins/massiv @@ -99,6 +99,7 @@ , Data.Massiv.Array.DelayedSpec , Data.Massiv.Array.Delayed.InterleavedSpec , Data.Massiv.Array.Delayed.WindowedSpec + , Data.Massiv.Array.Delayed.PushSpec , Data.Massiv.Array.ManifestSpec , Data.Massiv.Array.Manifest.VectorSpec , Data.Massiv.Array.MutableSpec 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 @@ -36,7 +36,7 @@ -- * `M` - General manifest array type, that any of the above representations can be converted to in -- constant time using `toManifest`. -- --- There are also array represnetation that only describe how values for its elements can be +-- There are also array representations that only describe how values for its elements can be -- computed or loaded into memory, as such, they are represented by functions and do not impose the -- memory overhead, that is normally associated with arrays. They are needed for proper fusion and -- parallelization of computation. @@ -49,7 +49,7 @@ -- as /Push/ array. Useful for fusing various array combining functions. Use `computeAs` in -- order to load array into `Manifest` representation. -- --- * `DI` - delayed interleaved array. Same as `D`, but performes better with unbalanced +-- * `DI` - delayed interleaved array. Same as `D`, but performs better with unbalanced -- computation, when evaluation of one element takes much longer than of its neighbor. -- -- * `DW` - delayed windowed array. This peculiar representation allows for very fast `Stencil` @@ -59,7 +59,7 @@ -- -- * `L` and `LN` - those types aren't particularly useful on their own, but because of their unique -- ability to be converted to and from nested lists in constant time, provide a perfect --- intermediary for lists <-> array conversion. +-- intermediary for lists \<-> array conversion. -- -- Most of the `Manifest` arrays are capable of in-place mutation. Check out -- "Data.Massiv.Array.Mutable" module for available functionality. @@ -159,3 +159,5 @@ All folding is done in a row-major order. -} + + diff --git a/src/Data/Massiv/Array/Ops/Transform.hs b/src/Data/Massiv/Array/Ops/Transform.hs --- a/src/Data/Massiv/Array/Ops/Transform.hs +++ b/src/Data/Massiv/Array/Ops/Transform.hs @@ -33,6 +33,9 @@ , extractFromToM , extractFromTo , extractFromTo' + , deleteRowsM + , deleteColumnsM + , deleteRegionM -- ** Append/Split , cons , unconsM @@ -46,6 +49,7 @@ , splitAtM , splitAt , splitAt' + , splitExtractM -- ** Upsample/Downsample , upsample , downsample @@ -62,7 +66,7 @@ ) where import Control.Scheduler (traverse_) -import Control.Monad as M (foldM_, unless) +import Control.Monad as M (foldM_, unless, forM_) import Data.Bifunctor (bimap) import Data.Foldable as F (foldl', foldrM, toList) import qualified Data.List as L (uncons) @@ -189,6 +193,7 @@ {-# INLINE resize' #-} -- | /O(1)/ - Reduce a multi-dimensional array into a flat vector +-- -- @since 0.3.1 flatten :: (Load r ix e, Resize r ix) => Array r ix e -> Array r Ix1 e flatten arr = unsafeResize (SafeSz (totalElem (size arr))) arr @@ -437,7 +442,7 @@ -- @since 0.3.0 unsnocM :: (MonadThrow m, Source r Ix1 e) => Array r Ix1 e -> m (Array D Ix1 e, e) unsnocM arr - | 0 == totalElem sz = throwM $ SizeEmptyException sz + | k < 0 = throwM $ SizeEmptyException sz | otherwise = pure (makeArray (getComp arr) (SafeSz k) (unsafeLinearIndex arr), unsafeLinearIndex arr k) where @@ -446,6 +451,7 @@ {-# INLINE unsnocM #-} + -- | Append two arrays together along a particular dimension. Sizes of both arrays must match, with -- an allowed exception of the dimension they are being appended along, otherwise `Nothing` is -- returned. @@ -600,34 +606,146 @@ -> Int -- ^ Index along the dimension to split at -> Array r ix e -- ^ Source array -> Maybe (Array r' ix e, Array r' ix e) -splitAt dim i arr = do - let Sz sz = size arr - eIx <- setDimM sz dim i - sIx <- setDimM zeroIndex dim i - arr1 <- extractFromTo zeroIndex eIx arr - arr2 <- extractFromTo sIx sz arr - return (arr1, arr2) +splitAt = splitAtM {-# INLINE splitAt #-} {-# DEPRECATED splitAt "In favor of a more general `splitAtM`" #-} -- | Same as `splitAt`, but will throw an error instead of returning `Nothing` on wrong dimension -- and index out of bounds. +-- +-- @since 0.1.0 splitAt' :: (Extract r ix e, r' ~ EltRepr r ix) => Dim -> Int -> Array r ix e -> (Array r' ix e, Array r' ix e) splitAt' dim i arr = either throw id $ splitAtM dim i arr {-# INLINE splitAt' #-} +-- | Split an array in three parts across some dimension +-- +-- @since 0.3.5 +splitExtractM :: + (MonadThrow m, Extract r ix e, Source r' ix e, r' ~ EltRepr r ix) + => Dim -- ^ Dimension along which to do the extraction + -> Ix1 -- ^ Start index along the dimension that needs to be extracted + -> Sz Ix1 -- ^ Size of the extracted array along the dimension that it will be extracted + -> Array r ix e + -> m (Array r' ix e, Array r' ix e, Array r' ix e) +splitExtractM dim startIx1 (Sz extractSzIx1) arr = do + let Sz szIx = size arr + midStartIx <- setDimM zeroIndex dim startIx1 + midExtractSzIx <- setDimM szIx dim extractSzIx1 + midArr <- extractM midStartIx (Sz midExtractSzIx) arr + leftArrSzIx <- setDimM szIx dim startIx1 + leftArr <- extractM zeroIndex (Sz leftArrSzIx) arr + rightArrStartIx <- setDimM zeroIndex dim (startIx1 + extractSzIx1) + rightArr <- extractFromToM rightArrStartIx szIx arr + pure (leftArr, midArr, rightArr) +{-# INLINE splitExtractM #-} + +-- | Delete a region from an array along the specified dimension. +-- +-- ==== __Examples__ +-- +-- >>> import Data.Massiv.Array +-- >>> arr = fromIx3 <$> (0 :> 0 :. 0 ..: 3 :> 2 :. 6) +-- >>> deleteRegionM 1 2 3 arr +-- Array DL Seq (Sz (3 :> 2 :. 3)) +-- [ [ [ (0,0,0), (0,0,1), (0,0,5) ] +-- , [ (0,1,0), (0,1,1), (0,1,5) ] +-- ] +-- , [ [ (1,0,0), (1,0,1), (1,0,5) ] +-- , [ (1,1,0), (1,1,1), (1,1,5) ] +-- ] +-- , [ [ (2,0,0), (2,0,1), (2,0,5) ] +-- , [ (2,1,0), (2,1,1), (2,1,5) ] +-- ] +-- ] +-- >>> v = Ix1 0 ... 10 +-- >>> deleteRegionM 1 3 5 v +-- Array DL Seq (Sz1 6) +-- [ 0, 1, 2, 8, 9, 10 ] +-- +-- @since 0.3.5 +deleteRegionM :: + (MonadThrow m, Extract r ix e, Source (EltRepr r ix) ix e) + => Dim -- ^ Along which axis should the removal happen + -> Ix1 -- ^ At which index to start dropping slices + -> Sz Ix1 -- ^ Number of slices to drop + -> Array r ix e -- ^ Array that will have it's subarray removed + -> m (Array DL ix e) +deleteRegionM dim ix sz arr = do + (leftArr, _, rightArr) <- splitExtractM dim ix sz arr + appendM dim leftArr rightArr +{-# INLINE deleteRegionM #-} + +-- | Similar to `deleteRegionM`, but drop a specified number of rows from an array that +-- has at least 2 dimensions. +-- +-- ====__Example__ +-- +-- >>> import Data.Massiv.Array +-- >>> arr = fromIx2 <$> (0 :. 0 ..: 3 :. 6) +-- >>> arr +-- Array D Seq (Sz (3 :. 6)) +-- [ [ (0,0), (0,1), (0,2), (0,3), (0,4), (0,5) ] +-- , [ (1,0), (1,1), (1,2), (1,3), (1,4), (1,5) ] +-- , [ (2,0), (2,1), (2,2), (2,3), (2,4), (2,5) ] +-- ] +-- >>> deleteRowsM 1 1 arr +-- Array DL Seq (Sz (2 :. 6)) +-- [ [ (0,0), (0,1), (0,2), (0,3), (0,4), (0,5) ] +-- , [ (2,0), (2,1), (2,2), (2,3), (2,4), (2,5) ] +-- ] +-- +-- @since 0.3.5 +deleteRowsM :: + (MonadThrow m, Extract r ix e, Source (EltRepr r ix) ix e, Index (Lower ix)) + => Ix1 + -> Sz Ix1 + -> Array r ix e + -> m (Array DL ix e) +deleteRowsM = deleteRegionM 2 +{-# INLINE deleteRowsM #-} + +-- | Similar to `deleteRegionM`, but drop a specified number of columns an array. +-- +-- ====__Example__ +-- +-- >>> import Data.Massiv.Array +-- >>> arr = fromIx2 <$> (0 :. 0 ..: 3 :. 6) +-- >>> arr +-- Array D Seq (Sz (3 :. 6)) +-- [ [ (0,0), (0,1), (0,2), (0,3), (0,4), (0,5) ] +-- , [ (1,0), (1,1), (1,2), (1,3), (1,4), (1,5) ] +-- , [ (2,0), (2,1), (2,2), (2,3), (2,4), (2,5) ] +-- ] +-- >>> deleteColumnsM 2 3 arr +-- Array DL Seq (Sz (3 :. 3)) +-- [ [ (0,0), (0,1), (0,5) ] +-- , [ (1,0), (1,1), (1,5) ] +-- , [ (2,0), (2,1), (2,5) ] +-- ] +-- +-- @since 0.3.5 +deleteColumnsM :: + (MonadThrow m, Extract r ix e, Source (EltRepr r ix) ix e) + => Ix1 + -> Sz Ix1 + -> Array r ix e + -> m (Array DL ix e) +deleteColumnsM = deleteRegionM 1 +{-# INLINE deleteColumnsM #-} + + -- | Discard elements from the source array according to the stride. -- -- @since 0.3.0 --- downsample :: Source r ix e => Stride ix -> Array r ix e -> Array DL ix e -downsample !stride arr = +downsample stride arr = DLArray { dlComp = getComp arr , dlSize = resultSize - , dlDefault = Nothing + , dlDefault = defaultElement arr , dlLoad = \scheduler startAt dlWrite -> splitLinearlyWithStartAtM_ @@ -651,20 +769,19 @@ -- @since 0.3.0 upsample :: Load r ix e => e -> Stride ix -> Array r ix e -> Array DL ix e -upsample !fillWith !safeStride arr = +upsample !fillWith safeStride arr = DLArray { dlComp = getComp arr , dlSize = newsz - , dlDefault = Nothing + , dlDefault = Just fillWith , dlLoad = \scheduler startAt dlWrite -> do - unless (stride == pureIndex 1) $ - loopM_ startAt (< totalElem newsz) (+ 1) (`dlWrite` fillWith) - -- TODO: experiment a bit more. So far the fastest solution is to prefill the whole array - -- with default value and override non-stride elements afterwards. This approach seems a - -- bit wasteful, nevertheless it is fastest - -- - -- TODO: Is it possible to use fast fill operation that is available for MutableByteArray? + M.forM_ (defaultElement arr) $ \prevFillWith -> + loopM_ + startAt + (< totalElem sz) + (+ 1) + (\i -> dlWrite (adjustLinearStride (i + startAt)) prevFillWith) loadArrayM scheduler arr (\i -> dlWrite (adjustLinearStride (i + startAt))) } where @@ -676,17 +793,6 @@ !sz = size arr !newsz = SafeSz (timesStride $ unSz sz) {-# INLINE upsample #-} - - -- This was a sample optimization, that turned out to be significantly (~ x9) slower - -- makeLoadArray (getComp arr) newsz $ \numWorkers scheduleWith dlWrite -> do - -- iterM_ zeroIndex stride (pureIndex 1) (<) $ \ixs -> - -- if ixs == zeroIndex - -- then loadArray numWorkers scheduleWith arr $ \ !i -> dlWrite (adjustLinearStride i) - -- else let !is = toLinearIndex newsz ixs - -- in scheduleWith $ - -- loopM_ 0 (< totalElem sz) (+ 1) $ \ !i -> - -- dlWrite (is + adjustLinearStride i) fillWith - -- | Create an array by traversing a source array. diff --git a/src/Data/Massiv/Array/Stencil.hs b/src/Data/Massiv/Array/Stencil.hs --- a/src/Data/Massiv/Array/Stencil.hs +++ b/src/Data/Massiv/Array/Stencil.hs @@ -74,7 +74,7 @@ -- otherwise performance will be terrible. -- -- > average3x3Stencil :: (Default a, Fractional a) => Stencil Ix2 a a --- > average3x3Stencil = makeStencil (3 :. 3) (1 :. 1) $ \ get -> +-- > average3x3Stencil = makeStencil (Sz (3 :. 3)) (1 :. 1) $ \ get -> -- > ( get (-1 :. -1) + get (-1 :. 0) + get (-1 :. 1) + -- > get ( 0 :. -1) + get ( 0 :. 0) + get ( 0 :. 1) + -- > get ( 1 :. -1) + get ( 1 :. 0) + get ( 1 :. 1) ) / 9 diff --git a/src/Data/Massiv/Core.hs b/src/Data/Massiv/Core.hs --- a/src/Data/Massiv/Core.hs +++ b/src/Data/Massiv/Core.hs @@ -11,7 +11,7 @@ , Elt , EltRepr , Construct - , Load(loadArrayM) + , Load(loadArrayM, defaultElement) , Source , Resize , Extract diff --git a/src/Data/Massiv/Core/Common.hs b/src/Data/Massiv/Core/Common.hs --- a/src/Data/Massiv/Core/Common.hs +++ b/src/Data/Massiv/Core/Common.hs @@ -205,13 +205,18 @@ class (Typeable r, Index ix) => Load r ix e where -- | Get computation strategy of this array - + -- + -- @since 0.1.0 getComp :: Array r ix e -> Comp -- | Get the size of an immutabe array + -- + -- @since 0.1.0 size :: Array r ix e -> Sz ix -- | Load an array into memory. + -- + -- @since 0.3.0 loadArrayM :: Monad m => Scheduler m () diff --git a/src/Data/Massiv/Core/Exception.hs b/src/Data/Massiv/Core/Exception.hs --- a/src/Data/Massiv/Core/Exception.hs +++ b/src/Data/Massiv/Core/Exception.hs @@ -34,7 +34,11 @@ displayException Uninitialized = "Array element is uninitialized" +-- | Throw `SizeElementsMismatchException` whenever number of elements in both sizes do +-- not match. +-- +-- @since 0.3.5 guardNumberOfElements :: (MonadThrow m, Index ix, Index ix') => Sz ix -> Sz ix' -> m () guardNumberOfElements sz sz' = - unless (totalElem sz == totalElem sz) $ throwM $ SizeElementsMismatchException sz sz' + unless (totalElem sz == totalElem sz') $ throwM $ SizeElementsMismatchException sz sz' {-# INLINE guardNumberOfElements #-} diff --git a/src/Data/Massiv/Core/Index.hs b/src/Data/Massiv/Core/Index.hs --- a/src/Data/Massiv/Core/Index.hs +++ b/src/Data/Massiv/Core/Index.hs @@ -85,18 +85,20 @@ , IndexException(..) , SizeException(..) , ShapeException(..) + , guardNumberOfElements ) where -import Control.Exception (throw) -import Control.DeepSeq -import Control.Monad.Catch (MonadThrow(..)) -import Data.Functor.Identity (runIdentity) -import Data.Massiv.Core.Index.Internal -import Data.Massiv.Core.Index.Tuple -import Data.Massiv.Core.Index.Ix -import Data.Massiv.Core.Index.Stride -import Data.Massiv.Core.Iterator -import GHC.TypeLits +import Control.DeepSeq +import Control.Exception (throw) +import Control.Monad.Catch (MonadThrow(..)) +import Data.Functor.Identity (runIdentity) +import Data.Massiv.Core.Exception (guardNumberOfElements) +import Data.Massiv.Core.Index.Internal +import Data.Massiv.Core.Index.Ix +import Data.Massiv.Core.Index.Stride +import Data.Massiv.Core.Index.Tuple +import Data.Massiv.Core.Iterator +import GHC.TypeLits -- | Approach to be used near the borders during various transformations. -- Whenever a function needs information not only about an element of interest, but diff --git a/src/Data/Massiv/Core/Index/Internal.hs b/src/Data/Massiv/Core/Index/Internal.hs --- a/src/Data/Massiv/Core/Index/Internal.hs +++ b/src/Data/Massiv/Core/Index/Internal.hs @@ -632,7 +632,7 @@ -- | Index contains a zero value along one of the dimensions. IndexZeroException :: Index ix => !ix -> IndexException -- | Dimension is out of reach. - IndexDimensionException :: (Show ix, Typeable ix) => !ix -> Dim -> IndexException + IndexDimensionException :: (Show ix, Typeable ix) => !ix -> !Dim -> IndexException -- | Index is out of bounds. IndexOutOfBoundsException :: Index ix => !(Sz ix) -> !ix -> IndexException @@ -645,6 +645,16 @@ showsPrec 0 arr s = show arr ++ s showsPrec _ arr s = '(' : show arr ++ ")" ++ s +instance Eq IndexException where + e1 == e2 = + case (e1, e2) of + (IndexZeroException i1, IndexZeroException i2) -> show i1 == show i2 + (IndexDimensionException i1 d1, IndexDimensionException i2 d2) -> + show i1 == show i2 && d1 == d2 + (IndexOutOfBoundsException sz1 i1, IndexOutOfBoundsException sz2 i2) -> + show sz1 == show sz2 && show i1 == show i2 + _ -> False + instance Exception IndexException -- | Exception that indicates an issue with an array size. @@ -659,6 +669,18 @@ SizeSubregionException :: Index ix => !(Sz ix) -> !ix -> !(Sz ix) -> SizeException -- | An array with the size cannot contain any elements. SizeEmptyException :: Index ix => !(Sz ix) -> SizeException + +instance Eq SizeException where + e1 == e2 = + case (e1, e2) of + (SizeMismatchException sz1 sz1', SizeMismatchException sz2 sz2') -> + show sz1 == show sz2 && show sz1' == show sz2' + (SizeElementsMismatchException sz1 sz1', SizeElementsMismatchException sz2 sz2') -> + show sz1 == show sz2 && show sz1' == show sz2' + (SizeSubregionException sz1 i1 sz1', SizeSubregionException sz2 i2 sz2') -> + show sz1 == show sz2 && show i1 == show i2 && show sz1' == show sz2' + (SizeEmptyException sz1, SizeEmptyException sz2) -> show sz1 == show sz2 + _ -> False instance Exception SizeException diff --git a/src/Data/Massiv/Core/Index/Ix.hs b/src/Data/Massiv/Core/Index/Ix.hs --- a/src/Data/Massiv/Core/Index/Ix.hs +++ b/src/Data/Massiv/Core/Index/Ix.hs @@ -64,8 +64,7 @@ -- @since 0.1.0 data Ix2 = {-# UNPACK #-} !Int :. {-# UNPACK #-} !Int --- | 2-dimensional index constructor. Useful when @TypeOperators@ extension isn't enabled, or simply --- infix notation is inconvenient. @(Ix2 i j) == (i :. j)@. +-- | 2-dimensional index constructor. Useful when infix notation is inconvenient. @(Ix2 i j) == (i :. j)@ -- -- @since 0.1.0 pattern Ix2 :: Int -> Int -> Ix2 @@ -76,7 +75,7 @@ -- @since 0.3.0 type Sz2 = Sz Ix2 --- | 2-dimensional size constructor. @(Sz2 i j) == Sz (i :. j)@. +-- | 2-dimensional size constructor. @(Sz2 i j) == Sz (i :. j)@ -- -- @since 0.3.0 pattern Sz2 :: Int -> Int -> Sz2 @@ -89,7 +88,7 @@ -- @since 0.1.0 type Ix3 = IxN 3 --- | 3-dimensional index constructor. @(Ix3 i j k) == (i :> j :. k)@. +-- | 3-dimensional index constructor. @(Ix3 i j k) == (i :> j :. k)@ -- -- @since 0.1.0 pattern Ix3 :: Int -> Int -> Int -> Ix3 @@ -100,7 +99,7 @@ -- @since 0.3.0 type Sz3 = Sz Ix3 --- | 3-dimensional size constructor. @(Sz3 i j k) == Sz (i :> j :. k)@. +-- | 3-dimensional size constructor. @(Sz3 i j k) == Sz (i :> j :. k)@ -- -- @since 0.3.0 pattern Sz3 :: Int -> Int -> Int -> Sz3 @@ -112,7 +111,7 @@ -- @since 0.1.0 type Ix4 = IxN 4 --- | 4-dimensional index constructor. @(Ix4 i j k l) == (i :> j :> k :. l)@. +-- | 4-dimensional index constructor. @(Ix4 i j k l) == (i :> j :> k :. l)@ -- -- @since 0.1.0 pattern Ix4 :: Int -> Int -> Int -> Int -> Ix4 @@ -123,7 +122,7 @@ -- @since 0.3.0 type Sz4 = Sz Ix4 --- | 4-dimensional size constructor. @(Sz4 i j k l) == Sz (i :> j :> k :. l)@. +-- | 4-dimensional size constructor. @(Sz4 i j k l) == Sz (i :> j :> k :. l)@ -- -- @since 0.3.0 pattern Sz4 :: Int -> Int -> Int -> Int -> Sz4 @@ -135,7 +134,7 @@ -- @since 0.1.0 type Ix5 = IxN 5 --- | 5-dimensional index constructor. @(Ix5 i j k l m) == (i :> j :> k :> l :. m)@. +-- | 5-dimensional index constructor. @(Ix5 i j k l m) == (i :> j :> k :> l :. m)@ -- -- @since 0.1.0 pattern Ix5 :: Int -> Int -> Int -> Int -> Int -> Ix5 @@ -146,7 +145,7 @@ -- @since 0.3.0 type Sz5 = Sz Ix5 --- | 5-dimensional size constructor. @(Sz5 i j k l m) == Sz (i :> j :> k :> l :. m)@. +-- | 5-dimensional size constructor. @(Sz5 i j k l m) == Sz (i :> j :> k :> l :. m)@ -- -- @since 0.3.0 pattern Sz5 :: Int -> Int -> Int -> Int -> Int -> Sz5 diff --git a/tests/Data/Massiv/Array/Delayed/PushSpec.hs b/tests/Data/Massiv/Array/Delayed/PushSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Data/Massiv/Array/Delayed/PushSpec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +module Data.Massiv.Array.Delayed.PushSpec (spec) where + +import Data.Massiv.Array.Delayed +import Data.Massiv.Array.Unsafe +import Data.Massiv.CoreArbitrary as A +import Data.Typeable + + +-- prop_upsampleDifferentDefault :: +-- Proxy ix -> Comp -> SzIx ix -> Int -> Maybe Int -> Property +-- prop_upsampleDifferentDefault _ comp (SzIx sz ix) v mDef = +-- computeAs P (unsafeMakeLoadArray comp sz mDef $ \ put -> put ix v) + + +spec :: Spec +spec = pure () + -- describe "upsampleDifferentDefault" $ do + -- it "Ix1" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix1) + -- it "Ix2" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix2) + -- it "Ix3" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix3) + -- it "Ix4" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix4) + -- it "Ix5" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix5) + + +identityDL :: Int -> Array DL Ix2 Int +identityDL n = makeLoadArrayS (Sz2 n n) 0 $ \ writeCell -> do + let f i = writeCell (i :. i) 1 + A.mapM_ f (0 ... n - 1) 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 @@ -25,6 +25,18 @@ prop_ExtractAppend (DimIx dim) (ArrIx arr ix) = arr === compute (uncurry (append' dim) $ A.splitAt' dim (getDim' ix dim) arr) +prop_SplitExtract + :: (Show (Array P ix Int), Show (Array M ix Int), Index ix) + => DimIx ix -> ArrIx P ix Int -> Positive Int -> Property +prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) = + (computeAs P <$> splitAt' dim i arr) === (left, computeAs P (append' dim center right)) .&&. + (computeAs P splitLeft, splitRight) === (computeAs P (append' dim left center), right) + where i = getDim' ix dim + k = getDim' (unSz (size arr)) dim + n' = n `mod` (k - i) + (left, center, right) = either throw id (splitExtractM dim i (Sz n') arr) + (splitLeft, splitRight) = splitAt' dim (i + n') arr + prop_ConcatAppend :: (Show (Array P ix Int), Index ix) => DimIx ix -> Comp -> Sz ix -> NonEmptyList (Fun ix Int) -> Property @@ -44,6 +56,13 @@ prop_ConcatMconcat arrs = computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs)) +prop_ExtractSizeMismatch :: + Index ix => ArrTiny P ix Int -> Positive Int -> Property +prop_ExtractSizeMismatch (ArrTiny arr) (Positive n) = + assertExceptionIO (SizeElementsMismatchException sz sz' ==) $ resizeM sz' arr + where + sz = size arr + sz' = Sz (totalElem sz + n) spec :: Spec spec = do @@ -53,11 +72,21 @@ it "Ix2" $ property (prop_upsampleDownsample @Ix2) it "Ix3" $ property (prop_upsampleDownsample @Ix3) it "Ix4" $ property (prop_upsampleDownsample @Ix4) + describe "extractSizeMismatch" $ do + it "Ix1" $ property (prop_ExtractSizeMismatch @Ix1) + it "Ix2" $ property (prop_ExtractSizeMismatch @Ix2) + it "Ix3" $ property (prop_ExtractSizeMismatch @Ix3) + it "Ix4" $ property (prop_ExtractSizeMismatch @Ix4) describe "ExtractAppend" $ do - it "Ix1" $ property (prop_ExtractAppend @Ix1) -- modifyMaxSuccess (`div` 10) + it "Ix1" $ property (prop_ExtractAppend @Ix1) it "Ix2" $ property (prop_ExtractAppend @Ix2) it "Ix3" $ property (prop_ExtractAppend @Ix3) it "Ix4" $ property (prop_ExtractAppend @Ix4) + describe "ExtractAppend" $ do + it "Ix1" $ property (prop_SplitExtract @Ix1) + it "Ix2" $ property (prop_SplitExtract @Ix2) + it "Ix3" $ property (prop_SplitExtract @Ix3) + it "Ix4" $ property (prop_SplitExtract @Ix4) describe "ConcatAppend" $ do it "Ix1" $ property (prop_ConcatAppend @Ix1) it "Ix2" $ property (prop_ConcatAppend @Ix2)