massiv-test 0.1.1 → 0.1.2

raw patch · 12 files changed

+593/−264 lines, 12 filesdep ~massivPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: massiv

API changes (from Hackage documentation)

Files

• massiv-test.cabal +4/−4
• src/Test/Massiv/Core.hs +2/−0
• src/Test/Massiv/Core/Index.hs +12/−1
• src/Test/Massiv/Utils.hs +1/−1
• tests/Data/Massiv/Array/Ops/FoldSpec.hs +52/−25
• tests/Data/Massiv/Array/Ops/SortSpec.hs +0/−18
• tests/Data/Massiv/Array/Ops/TransformSpec.hs +0/−158
• tests/Data/Massiv/Array/StencilSpec.hs +133/−45
• tests/Test/Massiv/Array/MutableSpec.hs +115/−10
• tests/Test/Massiv/Array/Ops/SortSpec.hs +30/−0
• tests/Test/Massiv/Array/Ops/TransformSpec.hs +239/−0
• tests/Test/Massiv/Core/IndexSpec.hs +5/−2

@@ -1,5 +1,5 @@ name:                massiv-test-version:             0.1.1+version:             0.1.2 synopsis:            Library that contains generators, properties and tests for Massiv Array Library. description:         This library is designed for users of massiv library that need random generators for writing custom property tests and reusing some of the predefined ones. homepage:            https://github.com/lehins/massiv@@ -32,7 +32,7 @@                      , exceptions                      , QuickCheck                      , hspec-                     , massiv >= 0.4.2+                     , massiv >= 0.4.5                      , scheduler                      , primitive                      , unliftio@@ -55,6 +55,8 @@                     , Test.Massiv.Core.SchedulerSpec                     , Test.Massiv.Array.Delayed.StreamSpec                     , Test.Massiv.Array.MutableSpec+                    , Test.Massiv.Array.Ops.TransformSpec+                    , Test.Massiv.Array.Ops.SortSpec                       -- TODO: Below should be moved to Test.Massiv.Array                     , Data.Massiv.Array.Delayed.InterleavedSpec                     , Data.Massiv.Array.Delayed.PushSpec@@ -67,8 +69,6 @@                     , Data.Massiv.Array.Ops.FoldSpec                     , Data.Massiv.Array.Ops.MapSpec                     , Data.Massiv.Array.Ops.SliceSpec-                    , Data.Massiv.Array.Ops.SortSpec-                    , Data.Massiv.Array.Ops.TransformSpec                     , Data.Massiv.Array.StencilSpec                     , Data.Massiv.ArraySpec   build-depends:      base

@@ -2,8 +2,10 @@   ( module Index   , module Commmon   , module Utils+  , module Test.Hspec.QuickCheck   ) where  import Test.Massiv.Core.Index as Index (DimIx(..), SzIx(..), SzNE(..)) import Test.Massiv.Core.Common as Commmon import Test.Massiv.Utils as Utils+import Test.Hspec.QuickCheck

@@ -16,6 +16,7 @@   ( DimIx(..)   , SzNE(..)   , SzIx(..)+  , SzTiny(..)   , ixToList   , arbitraryIx1   , toIx@@ -87,6 +88,15 @@     SzIx sz . flip (liftIndex2 mod) (unSz sz) <$> arbitrary  +++newtype SzTiny ix = SzTiny { unSzTiny :: Sz ix }+  deriving (Show, Eq)++instance (Arbitrary ix, Index ix) => Arbitrary (SzTiny ix) where+  arbitrary = SzTiny . liftSz (`mod` 10) <$> arbitrary++ instance Arbitrary e => Arbitrary (Border e) where   arbitrary =     oneof@@ -405,7 +415,8 @@   ixSpec ::-     forall ix. (Typeable (Lower ix), Arbitrary (Lower ix), Typeable ix, Index ix, Arbitrary ix)+     forall ix. (Typeable (Lower ix), Arbitrary (Lower ix), Typeable ix, Index ix, Arbitrary ix+                , IsIndexDimension ix (Dimensions ix))   => Spec ixSpec = do   let threshold = 50000

@@ -23,7 +23,7 @@ import Test.QuickCheck.Monadic as X import Test.Hspec as X import Test.QuickCheck.Function as X-import Control.DeepSeq (NFData, deepseq)+import Control.DeepSeq as X (NFData, deepseq) import UnliftIO.Exception (Exception(..), SomeException, catch, catchAny) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup as X ((<>))

@@ -1,40 +1,35 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} module Data.Massiv.Array.Ops.FoldSpec (spec) where  import qualified Data.Foldable as F import Data.Massiv.Array as A-import Test.Massiv.Core import Data.Semigroup import Prelude hiding (map, product, sum)+import Test.Massiv.Core   -prop_SumSEqSumP :: Index ix => proxy ix -> Array D ix Int -> Bool-prop_SumSEqSumP _ arr = sum arr == sum (setComp Par arr)+prop_SumSEqSumP :: Index ix => Array D ix Int -> Bool+prop_SumSEqSumP arr = sum arr == sum (setComp Par arr)  -prop_ProdSEqProdP :: Index ix => proxy ix -> Array D ix Int -> Bool-prop_ProdSEqProdP _ arr = product arr == product (setComp Par arr)--prop_NestedFoldP :: Array D Ix1 (Array D Ix1 Int) -> Bool-prop_NestedFoldP arr = sum (setComp Par (map sum $ setComp Par arr)) == sum (map sum arr)+prop_ProdSEqProdP :: Index ix => Array D ix Int -> Bool+prop_ProdSEqProdP arr = product arr == product (setComp Par arr)  -specFold ::-     (Arbitrary ix, Index ix, Show (Array D ix Int))-  => proxy ix-  -> String-  -> Spec-specFold proxy dimStr =-  describe dimStr $ do-    it "sumS Eq sumP" $ property $ prop_SumSEqSumP proxy-    it "prodS Eq prodP" $ property $ prop_ProdSEqProdP proxy--foldOpsProp :: (Source P ix Int) => proxy ix -> Fun Int Bool -> ArrTinyNE P ix Int -> Property-foldOpsProp _ f (ArrTinyNE arr) =+foldOpsProp ::+     (Source P ix Int)+  => Fun Int Bool+  -> ArrTinyNE P ix Int+  -> Property+foldOpsProp f (ArrTinyNE arr) =   (A.maximum' arr === getMax (foldMono Max arr)) .&&.   (A.minimum' arr === getMin (foldSemi Min maxBound arr)) .&&.   (A.sum arr === F.sum ls) .&&.@@ -47,12 +42,44 @@   where     ls = toList arr ++prop_NestedFoldP :: Array D Ix1 (Array D Ix1 Int) -> Bool+prop_NestedFoldP arr = sum (setComp Par (map sum $ setComp Par arr)) == sum (map sum arr)+++specFold ::+     forall ix. (Arbitrary ix, Index ix, Show (Array D ix Int), Show (Array P ix Int))+  => String+  -> Spec+specFold dimStr =+  describe dimStr $ do+    it "sumS Eq sumP" $ property $ prop_SumSEqSumP @ix+    it "prodS Eq prodP" $ property $ prop_ProdSEqProdP @ix+    it "foldOps" $ property $ foldOpsProp @ix+++prop_foldOuterSliceToList ::+     (Elt P ix Int ~ Array M (Lower ix) Int, OuterSlice P ix Int, Index (Lower ix))+  => ArrTiny P ix Int+  -> Property+prop_foldOuterSliceToList (ArrTiny arr) =+  foldOuterSlice A.toList arr === A.fold (A.map pure arr)++ spec :: Spec spec = do-  specFold (Nothing :: Maybe Ix1) "Ix1"-  specFold (Nothing :: Maybe Ix2) "Ix2"+  specFold @Ix1 "Ix1"+  specFold @Ix2 "Ix2"+  specFold @Ix3 "Ix3"   it "Nested Parallel Fold" $ property prop_NestedFoldP   describe "Foldable Props" $ do-    it "Ix1" $ property $ foldOpsProp (Nothing :: Maybe Ix1)-    it "Ix2" $ property $ foldOpsProp (Nothing :: Maybe Ix2)-    it "Ix3" $ property $ foldOpsProp (Nothing :: Maybe Ix3)+    prop "Ix2" $ prop_foldOuterSliceToList @Ix2+    prop "Ix3" $ prop_foldOuterSliceToList @Ix3+    prop "Ix4" $ prop_foldOuterSliceToList @Ix4+  describe "Exceptions" $ do+    let emptySelector :: forall ix . Index ix => SizeException -> Bool+        emptySelector = (== SizeEmptyException (Sz (zeroIndex :: ix)))+    it "maximumM" $ maximumM (A.empty :: Array D Ix1 Int) `shouldThrow` emptySelector @Ix1+    it "minimumM" $ minimumM (A.empty :: Array D Ix2 Int) `shouldThrow` emptySelector @Ix2+    it "maximum'" $ (pure $! maximum' (A.empty :: Array D Ix3 Int)) `shouldThrow` emptySelector @Ix3+    it "minimum'" $ (pure $! minimum' (A.empty :: Array D Ix4 Int)) `shouldThrow` emptySelector @Ix4

@@ -1,18 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}-module Data.Massiv.Array.Ops.SortSpec (spec) where--import Data.List as L-import Data.Massiv.Array as A-import Test.Massiv.Core---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

@@ -1,158 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeApplications #-}-module Data.Massiv.Array.Ops.TransformSpec (spec) where--import Data.Massiv.Array as A-import Test.Massiv.Core-import Data.Sequence as S-import Prelude as P-import Data.Foldable as F (foldl', toList)-import Data.Maybe--prop_transposeOuterInner :: Array D Ix2 Int -> Property-prop_transposeOuterInner arr = transposeOuter arr === transpose arr--prop_upsampleDownsample ::-     (Show (Array P ix Int), Index ix) => ArrTiny P ix Int -> Stride ix -> Int -> Property-prop_upsampleDownsample (ArrTiny arr) stride fill =-  arr === compute (downsample stride (computeAs P (upsample fill stride arr)))--prop_ExtractAppend-  :: (Show (Array P ix Int), Index ix)-  => DimIx ix -> ArrIx P ix Int -> Property-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-prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) =-  foldl1 (\arr -> computeAs P . append' dim arr) arrs ===-  computeAs P (concat' dim arrs)-  where-    arrs = P.map (makeArrayR P comp sz . apply) fns--prop_AppendMappend-  :: Array D Ix1 Int -> Array D Ix1 Int -> Property-prop_AppendMappend arr1 arr2 =-  computeAs P (append' 1 arr1 arr2) === computeAs P (toLoadArray arr1 <> toLoadArray arr2)--prop_ConcatMconcat-  :: [Array D Ix1 Int] -> Property-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-  it "transposeOuterInner" $ property prop_transposeOuterInner-  describe "upsampleDownsample" $ do-    it "Ix1" $ property (prop_upsampleDownsample @Ix1)-    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)-    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)-    it "Ix3" $ property (prop_ConcatAppend @Ix3)-    it "Ix4" $ property (prop_ConcatAppend @Ix4)-  describe "Monoid" $ do-    it "Ix1" $ property prop_AppendMappend-    it "Ix1" $ property prop_ConcatMconcat-  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 =-  preJust $ do-    (arr', u, s) <--      if unconsFirst-        then do-          (u, au) <- unconsM arr-          (as, s) <- unsnocM au-          pure (as, u, s)-        else do-          (as, s) <- unsnocM arr-          (u, au) <- unconsM as-          pure (au, u, s)-    pure (computeAs U (A.snoc (A.cons u (toLoadArray (computeAs U arr'))) s) === compute arr)--preJust :: Testable prop => Maybe prop -> Property-preJust m = isJust m ==> fromJust m--prop_ConsSnoc :: Array D Ix1 Int -> [SeqOp Int] -> Property-prop_ConsSnoc arr ops =-  A.toList (computeAs U (foldl' applyArraySeqOp (toLoadArray arr) ops)) ===-  F.toList (foldl' applySequenceSeqOp (S.fromList (A.toList arr)) ops)--data SeqOp e = Cons e | Snoc e deriving (Eq, Show)--instance Arbitrary e => Arbitrary (SeqOp e) where-  arbitrary = do-    e <- arbitrary-    elements [Cons e, Snoc e]--applyArraySeqOp :: Array DL Ix1 e -> SeqOp e -> Array DL Ix1 e-applyArraySeqOp arr = \case-  Cons x -> A.cons x arr-  Snoc x -> A.snoc arr x---applySequenceSeqOp :: Seq a -> SeqOp a -> Seq a-applySequenceSeqOp arr = \case-  Cons x -> x <| arr-  Snoc x -> arr |> x

@@ -4,36 +4,50 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Data.Massiv.Array.StencilSpec (spec) where +import Prelude as P import Control.DeepSeq (deepseq) import Data.Default (Default(def)) import Data.Massiv.Array as A+import Data.Massiv.Array.Stencil.Unsafe as A import Test.Massiv.Core --- sum3x3Stencil :: Fractional a => Stencil Ix2 a a--- sum3x3Stencil = makeConvolutionStencil (3 :. 3) (1 :. 1) $ \ get ->---   get (-1 :. -1) 1 . get (-1 :. 0) 1 . get (-1 :. 1) 1 .---   get ( 0 :. -1) 1 . get ( 0 :. 0) 1 . get ( 0 :. 1) 1 .---   get ( 1 :. -1) 1 . get ( 1 :. 0) 1 . get ( 1 :. 1) 1--- {-# INLINE sum3x3Stencil #-}+avg3x3Stencil :: Fractional a => Stencil Ix2 a a+avg3x3Stencil = (/9) <$> makeConvolutionStencil (Sz 3) (1 :. 1) $ \ get ->+  get (-1 :. -1) 1 . get (-1 :. 0) 1 . get (-1 :. 1) 1 .+  get ( 0 :. -1) 1 . get ( 0 :. 0) 1 . get ( 0 :. 1) 1 .+  get ( 1 :. -1) 1 . get ( 1 :. 0) 1 . get ( 1 :. 1) 1   singletonStencil :: (Index ix) => (Int -> Int) -> Stencil ix Int Int singletonStencil f =   makeStencil oneSz zeroIndex $ \ get -> fmap f (get zeroIndex)-{-# INLINE singletonStencil #-}  -prop_MapSingletonStencil :: (Load DW ix Int, Manifest U ix Int) =>-                            Proxy ix -> Fun Int Int -> Border Int -> ArrNE U ix Int -> Bool+prop_MapSingletonStencil :: (Load DW ix Int, Manifest U ix Int, Show (Array U ix Int)) =>+                            Proxy ix -> Fun Int Int -> Border Int -> ArrNE U ix Int -> Property prop_MapSingletonStencil _ f b (ArrNE arr) =-  computeAs U (mapStencil b (singletonStencil (apply f)) arr) == computeAs U (A.map (apply f) arr)+  computeAs U (mapStencil b (singletonStencil (apply f)) arr) === computeAs U (A.map (apply f) arr) -prop_MapSingletonStencilWithStride :: (StrideLoad DW ix Int, Manifest U ix Int) =>-                                      Proxy ix -> Fun Int Int -> Border Int -> ArrNE U ix Int -> Bool+prop_ApplyZeroStencil ::+     (Load DW ix Int, Manifest U ix Int) => Proxy ix -> Int -> Array U ix Int -> Property+prop_ApplyZeroStencil _ e arr =+  assertSomeException $ computeAs U (applyStencil noPadding zeroStencil arr)+  where+    zeroStencil = makeStencil zeroSz zeroIndex $ \_get -> pure e+++prop_MapSingletonStencilWithStride ::+     (StrideLoad DW ix Int, Manifest U ix Int, Show (Array U ix Int))+  => Proxy ix+  -> Fun Int Int+  -> Border Int+  -> ArrNE U ix Int+  -> Property prop_MapSingletonStencilWithStride _ f b (ArrNE arr) =-  computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr) ==+  computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr) ===   computeAs U (A.map (apply f) arr)  -- Tests out of bounds stencil indexing@@ -45,6 +59,50 @@     ix' = liftIndex (* signum s) (setDim' zeroIndex r (getDim' (unSz sz) r))  +instance Index ix => Show (Stencil ix a b) where+  show stencil =+    "Stencil " ++ show (getStencilSize stencil) ++ " " ++ show (getStencilCenter stencil)+++prop_MapEqApplyStencil ::+     (Show (Array P ix Int), StrideLoad DW ix Int)+  => Stride ix+  -> SzTiny ix+  -> Border Int+  -> Array P ix Int+  -> Property+prop_MapEqApplyStencil stride (SzTiny sz) b arr =+  forAll (elements (P.zip [0 ..] (toList $ A.map (\(n, _, _) -> n) stencils))) $ \(i, _) ->+    let (_, stencil, g) = stencils ! i+     in computeAs P (mapStencilUnsafe b sz zeroIndex g arr) ===+        computeAs P (applyStencil (samePadding stencil b) stencil arr) .&&.+        computeWithStrideAs P stride (mapStencilUnsafe b sz zeroIndex g arr) ===+        computeWithStrideAs P stride (applyStencil (samePadding stencil b) stencil arr)+  where+    stencils = mkCommonStencils sz++mkCommonStencils ::+     (Bounded a, Num a, Ord a, Index ix)+  => Sz ix+  -> Array B Ix1 (String, Stencil ix a a, (ix -> a) -> a)+mkCommonStencils sz =+  fromList+    Seq+    [ (name, stencil sz, \get -> foldlS f acc0 $ fmap get (zeroIndex ..: unSz sz))+    | (name, stencil, f, acc0) <-+        [ ("maxStencil", maxStencil, max, minBound)+        , ("minStencil", minStencil, min, maxBound)+        , ("sumStencil", sumStencil, (+), 0)+        , ("productStencil", productStencil, (*), 1)+        ]+    ]++prop_FoldrStencil :: Load DW ix (Array DL Ix1 Int) => ArrNE P ix Int -> Property+prop_FoldrStencil (ArrNE arr) =+  computeAs P (computeAs B folded ! zeroIndex) === A.fromList Seq (foldrS (:) [] arr)+  where+    folded = applyStencil noPadding (foldrStencil cons A.empty (size arr)) arr+ stencilSpec :: Spec stencilSpec = do   describe "MapSingletonStencil" $ do@@ -57,12 +115,34 @@     it "Ix1" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix1)     it "Ix2" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix2)     it "Ix3" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix3)+  describe "ApplyZeroStencil" $ do+    it "Ix1" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix1)+    it "Ix2" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2)+    it "Ix3" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix3)+    it "Ix4" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix4)+    it "Ix2T" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2T)   describe "DangerousStencil" $ do     it "Ix1" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix1)     it "Ix2" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix2)     it "Ix3" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix3)     it "Ix4" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix4)-+  describe "MapEqApplyStencil" $ do+    it "Ix1" $ property $ prop_MapEqApplyStencil @Ix1+    it "Ix2" $ property $ prop_MapEqApplyStencil @Ix2+    it "Ix3" $ property $ prop_MapEqApplyStencil @Ix3+    it "Ix4" $ property $ prop_MapEqApplyStencil @Ix4+  describe "FoldrStencil" $ do+    it "Ix1" $ property $ prop_FoldrStencil @Ix1+    it "Ix2" $ property $ prop_FoldrStencil @Ix2+    it "Ix3" $ property $ prop_FoldrStencil @Ix3+    it "Ix4" $ property $ prop_FoldrStencil @Ix4+  describe "Simple" $ do+    it "sumStencil" $ property $ \ (arr :: Array B Ix2 Rational) border ->+      computeAs N (mapStencil border avg3x3Stencil arr) ===+      computeAs N (applyStencil (Padding 1 1 border) (avgStencil (Sz 3)) arr)+    it "sameSizeAndCenter" $ property $ \ (SzIx sz ix) ->+      let stencil = makeStencil sz ix ($ Ix1 0) :: Stencil Ix1 Int Int+      in getStencilSize stencil === sz .&&. getStencilCenter stencil === ix  stencilDirection :: Ix2 -> Array U Ix2 Int -> Array U Ix2 Int stencilDirection ix = computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix)@@ -89,63 +169,71 @@       ysConvXs4' = [4, 10, 20, 30, 34]       ysCorrXs4' = [20, 30, 40, 26, 14]       xs4f' f = f (-1) 1 . f 0 2 . f 1 3 . f 2 4+      mapStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int+      mapStencil1 s = computeAs U . mapStencil (Fill 0) s+      mapStencil2 :: Stencil Ix2 Int Int -> Array U Ix2 Int -> Array U Ix2 Int+      mapStencil2 s = computeAs U . mapStencil (Fill 0) s       applyStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int-      applyStencil1 s = computeAs U . mapStencil (Fill 0) s-      applyStencil2 :: Stencil Ix2 Int Int -> Array U Ix2 Int -> Array U Ix2 Int-      applyStencil2 s = computeAs U . mapStencil (Fill 0) s+      applyStencil1 s = computeAs U . applyStencil noPadding s   describe "makeConvolutionStencilFromKernel" $ do-    it "1x3" $ applyStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3-    it "1x4" $ applyStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4+    it "1x3 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3+    it "1x4 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4+    it "1x3 apply" $+      applyStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe`+      compute (extract' 1 3 ysConvXs3)+    it "1x4 apply" $+      applyStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe`+      compute (extract' 1 2 ysConvXs4)   describe "makeCorrelationStencilFromKernel" $ do-    it "1x3" $ applyStencil1 (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3-    it "1x4" $ applyStencil1 (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4+    it "1x3 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3+    it "1x4 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4   describe "makeConvolutionStencil" $ do-    it "1x3" $ applyStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysConvXs3-    it "1x4" $ applyStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysConvXs4-    it "1x4" $ applyStencil1 (makeConvolutionStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysConvXs4'+    it "1x3" $ mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysConvXs3+    it "1x4" $ mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysConvXs4+    it "1x4" $ mapStencil1 (makeConvolutionStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysConvXs4'   describe "makeCorrelationStencil" $ do-    it "1x3" $ applyStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysCorrXs3-    it "1x4" $ applyStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysCorrXs4-    it "1x4" $ applyStencil1 (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4'+    it "1x3" $ mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysCorrXs3+    it "1x4" $ mapStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysCorrXs4+    it "1x4" $ mapStencil1 (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4'   describe "makeConvolutionStencil == makeConvolutionStencilFromKernel" $ do     it "Sobel Horizontal" $       property $ \(arr :: Array U Ix2 Int) ->-        applyStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr ===-        applyStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr+        mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr ===+        mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr     it "1x3" $       property $ \(arr :: Array U Ix1 Int) ->-        applyStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr ===-        applyStencil1 (makeConvolutionStencilFromKernel xs3) arr+        mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr ===+        mapStencil1 (makeConvolutionStencilFromKernel xs3) arr     it "1x4" $       property $ \(arr :: Array U Ix1 Int) ->-        applyStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr ===-        applyStencil1 (makeConvolutionStencilFromKernel xs4) arr+        mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr ===+        mapStencil1 (makeConvolutionStencilFromKernel xs4) arr   describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do     it "Sobel Horizontal" $       property $ \(arr :: Array U Ix2 Int) ->-        applyStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr ===-        applyStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr+        mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr ===+        mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr     it "1x3" $       property $ \(arr :: Array U Ix1 Int) ->-        applyStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr ===-        applyStencil1 (makeCorrelationStencilFromKernel xs3) arr+        mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr ===+        mapStencil1 (makeCorrelationStencilFromKernel xs3) arr     it "1x4" $       property $ \(arr :: Array U Ix1 Int) ->-        applyStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr ===-        applyStencil1 (makeCorrelationStencilFromKernel xs4) arr+        mapStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr ===+        mapStencil1 (makeCorrelationStencilFromKernel xs4) arr   describe "makeConvolutionStencil == makeCorrelationStencil . rotate180" $ do     it "Sobel Horizontal" $       property $ \(arr :: Array U Ix2 Int) ->-        applyStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr ===-        applyStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr+        mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr ===+        mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr     it "1x3" $       property $ \(arr :: Array U Ix1 Int) ->-        applyStencil1 (makeConvolutionStencilFromKernel xs3) arr ===-        applyStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr+        mapStencil1 (makeConvolutionStencilFromKernel xs3) arr ===+        mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr     it "1x5" $       property $ \(arr :: Array U Ix1 Int) ->-        applyStencil1 (makeConvolutionStencilFromKernel ys) arr ===-        applyStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr+        mapStencil1 (makeConvolutionStencilFromKernel ys) arr ===+        mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr  spec :: Spec spec = do

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -8,7 +9,7 @@ {-# LANGUAGE TypeOperators #-} module Test.Massiv.Array.MutableSpec (spec) where -import Data.Massiv.Array+import Data.Massiv.Array as A import Test.Massiv.Core import Test.Massiv.Core.Mutable import Test.Massiv.Array.Delayed@@ -18,6 +19,10 @@ type MutableArraySpec r ix e    = ( Show e      , Eq e+     , Arbitrary e+     , Arbitrary ix+     , CoArbitrary e+     , Function e      , Eq (Array r ix e)      , Show (Array r ix e)      , Eq (Array (R r) Ix1 e)@@ -32,9 +37,6 @@  type MutableSpec r e    = ( Typeable e-     , Arbitrary e-     , CoArbitrary e-     , Function e      , IsList (Array r Ix1 e)      , Item (Array r Ix1 e) ~ e      , MutableArraySpec r Ix1 e@@ -43,10 +45,14 @@      , MutableArraySpec r Ix4 e      , MutableArraySpec r Ix5 e) -streamSpecR :: forall r ix e. (MutableArraySpec r ix e) => Spec-streamSpecR =+localMutableSpec :: forall r ix e. (MutableArraySpec r ix e) => Spec+localMutableSpec = do   describe "toStream/toList" $     it "toStream" $ property (prop_toStream @r @ix @e)+  describe "Mutable operations" $ do+    it "write" $ property (prop_Write @r @ix @e)+    it "modify" $ property (prop_Modify @r @ix @e)+    it "swap" $ property (prop_Swap @r @ix @e)  specMutableR :: forall r e. MutableSpec r e => Spec specMutableR = do@@ -59,10 +65,11 @@   mutableSpec @r @Ix2 @e   mutableSpec @r @Ix3 @e   mutableSpec @r @Ix4 @e-  streamSpecR @r @Ix1 @e-  streamSpecR @r @Ix2 @e-  streamSpecR @r @Ix3 @e-  streamSpecR @r @Ix4 @e+  localMutableSpec @r @Ix1 @e+  localMutableSpec @r @Ix2 @e+  localMutableSpec @r @Ix3 @e+  localMutableSpec @r @Ix4 @e+  localMutableSpec @r @Ix5 @e   describe "toStream/toList" $     it "toStreamIsList" $ property (prop_toStreamIsList @r @e)   --mutableSpec @r @Ix5 @e -- slows down the test suite@@ -76,6 +83,104 @@   unsafeMutableUnboxedSpec @r @Ix3 @e   unsafeMutableUnboxedSpec @r @Ix4 @e   unsafeMutableUnboxedSpec @r @Ix5 @e++prop_Write :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> ix -> e -> Property+prop_Write arr ix e =+  monadicIO $+  run $ do+    marr <- thaw arr+    A.read marr ix >>= \case+      Nothing ->+        let withExcept = assertExceptionIO (== IndexOutOfBoundsException (size arr) ix)+         in pure+              (withExcept (writeM marr ix e) .&&.+               (write marr ix e `shouldReturn` False) .&&.+               (write_ marr ix e `shouldReturn` ()))+      Just olde ->+        pure $+        property $ do+          indexM arr ix `shouldReturn` olde+          A.write marr ix e `shouldReturn` True+          A.read marr ix `shouldReturn` Just e++          marr' <- thaw arr+          writeM marr' ix e `shouldReturn` ()+          arr' <- freeze (getComp arr) marr'+          indexM arr' ix `shouldReturn` e++          arr'' <- withMArray arr (\_ ma -> write_ ma ix e)+          index' arr'' ix `shouldBe` e+++prop_Modify :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> Fun e e -> ix -> Property+prop_Modify arr f ix =+  monadicIO $+  run $ do+    marr <- thaw arr+    modify marr (pure . apply f) ix >>= \case+      Nothing ->+        let withExcept = assertExceptionIO (== IndexOutOfBoundsException (size arr) ix)+         in pure+              (withExcept (void $ indexM arr ix) .&&.+               withExcept (void $ readM marr ix) .&&.+               withExcept (void $ modifyM marr (pure . apply f) ix) .&&.+               withExcept (modifyM_ marr (pure . apply f) ix) .&&.+               (modify_ marr (pure . apply f) ix `shouldReturn` ()))+      Just e ->+        pure $+        property $ do+          let fM = pure . apply f+              fe = apply f e+          indexM arr ix `shouldReturn` e+          A.read marr ix `shouldReturn` Just fe++          marr' <- thawS arr+          readM marr' ix `shouldReturn` e+          modifyM marr' fM ix `shouldReturn` e+          arr' <- freezeS marr'+          indexM arr' ix `shouldReturn` fe++          arr'' <- withMArrayS arr (\ma -> modify_ ma fM ix)+          index' arr'' ix `shouldBe` fe++prop_Swap :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> ix -> ix -> Property+prop_Swap arr ix1 ix2 =+  monadicIO $+  run $ do+    marr <- thaw arr+    swap marr ix1 ix2 >>= \case+      Nothing ->+        let withExcept =+              assertExceptionIO+                (\case+                   IndexOutOfBoundsException _ _ -> True+                   _ -> False)+         in pure+              (withExcept (void $ indexM arr ix1 >> indexM arr ix2) .&&.+               withExcept (void $ readM marr ix1 >> readM marr ix2) .&&.+               withExcept (void $ swapM marr ix1 ix2) .&&.+               withExcept (void $ swapM marr ix2 ix1) .&&.+               withExcept (swapM_ marr ix1 ix2) .&&.+               withExcept (swapM_ marr ix2 ix1) .&&.+               (swap_ marr ix1 ix2 `shouldReturn` ()) .&&.+               (swap_ marr ix2 ix1 `shouldReturn` ()))+      Just (e1, e2) ->+        pure $+        property $ do+          indexM arr ix1 `shouldReturn` e1+          indexM arr ix2 `shouldReturn` e2+          readM marr ix1 `shouldReturn` e2+          readM marr ix2 `shouldReturn` e1++          marr' <- thawS arr+          swapM marr' ix1 ix2 `shouldReturn` (e1, e2)+          arr' <- freezeS marr'+          indexM arr' ix1 `shouldReturn` e2+          indexM arr' ix2 `shouldReturn` e1++          let arr'' = withMArrayST arr (\ma -> swap_ ma ix1 ix2)+          index' arr'' ix1 `shouldBe` e2+          index' arr'' ix2 `shouldBe` e1   

@@ -0,0 +1,30 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Array.Ops.SortSpec (spec) where++import Data.List as L+import Data.Massiv.Array as A+import Test.Massiv.Core as A+import Data.Foldable as F+import Data.Map.Strict as M++prop_IsSorted :: (b -> b) -> ([Int] -> b) -> (b -> [Int]) -> [Int] -> Property+prop_IsSorted sortWith from to xs =+  to (sortWith (from xs)) === sort xs++tallyMap :: Array P Ix1 Word -> Map Word Int+tallyMap arr = F.foldr' addCount M.empty $ toManifest arr+  where+    addCount :: Word -> Map Word Int -> Map Word Int+    addCount !el !counter = M.insertWith (+) el 1 counter+++spec :: Spec+spec = do+  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+  describe "Tally" $+    prop "Same as Map" $ \ arr ->+       M.toList (tallyMap arr) === F.toList (tally arr)

@@ -0,0 +1,239 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Array.Ops.TransformSpec (spec) where++import Data.Foldable as F (foldl', toList)+import Data.Massiv.Array as A+import Data.Maybe+import Data.Sequence as S+import Prelude as P+import Test.Massiv.Core++prop_TransposeOuterInner :: Array D Ix2 Int -> Property+prop_TransposeOuterInner arr = transposeOuter arr === transpose arr++prop_UpsampleDownsample ::+     forall r ix e . (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+  => ArrTiny r ix e+  -> Stride ix+  -> e+  -> Property+prop_UpsampleDownsample (ArrTiny arr) stride fill =+  arr === compute (downsample stride (compute @r (upsample fill stride arr)))++prop_ExtractAppend ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Show (Array r ix e)+     , Source (R r) ix e+     , Extract r ix e+     , Mutable r ix e+     )+  => DimIx ix+  -> ArrIx r ix e+  -> Property+prop_ExtractAppend (DimIx dim) (ArrIx arr ix) =+  arr === compute (uncurry (append' dim) $ A.splitAt' dim (getDim' ix dim) arr)++prop_SplitExtract ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Eq (Array (R r) ix e)+     , Show (Array r ix e)+     , Show (Array (R r) ix e)+     , Source (R r) ix e+     , Mutable r ix e+     , Extract r ix e+     )+  => DimIx ix+  -> ArrIx r ix e+  -> Positive Int+  -> Property+prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) =+  (compute @r <$> splitAt' dim i arr) === (left, compute @r (append' dim center right)) .&&.+  (compute @r splitLeft, splitRight) === (compute @r (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 ::+     forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Mutable r ix Int)+  => DimIx ix+  -> Comp+  -> Sz ix+  -> NonEmptyList (Fun ix Int)+  -> Property+prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) =+  foldl1 (\arr -> compute @r . append' dim arr) arrs ===+  compute @r (concat' dim arrs)+  where+    arrs = P.zipWith (\ f i -> makeArray @r comp sz ((+i) . apply f)) fns [0 .. ]++prop_ConcatMConcatOuterM ::+     forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Mutable r ix Int)+  => Comp+  -> Sz ix+  -> NonEmptyList (Fun ix Int)+  -> Property+prop_ConcatMConcatOuterM comp sz (NonEmpty fns) =+  property $ do+    as <- compute @r <$> concatM (dimensions sz) arrs+    as' <- compute @r <$> concatOuterM (P.map toLoadArray arrs)+    as `shouldBe` as'+  where+    arrs = P.zipWith (\ f i -> makeArray @r comp sz ((+i) . apply f)) fns [0 .. ]++prop_AppendMappend+  :: Array D Ix1 Int -> Array D Ix1 Int -> Property+prop_AppendMappend arr1 arr2 =+  computeAs P (append' 1 arr1 arr2) === computeAs P (toLoadArray arr1 <> toLoadArray arr2)++prop_ConcatMconcat+  :: [Array D Ix1 Int] -> Property+prop_ConcatMconcat arrs =+  computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs))++prop_ExtractSizeMismatch ::+     (Resize r ix, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> 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)++prop_ZoomWithGridStrideCompute ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Show (Array r ix e)+     , StrideLoad (R r) ix e+     , StrideLoad r ix e+     , Mutable r ix e+     , Extract r ix e+     )+  => Array r ix e+  -> Stride ix+  -> e+  -> Property+prop_ZoomWithGridStrideCompute arr stride defVal =+  (computeWithStride @r stride' arr' ===+   A.replicate Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal) .&&.+  (computeWithStride @r stride' (extract' (pureIndex 1) sz' arr') === compute arr)+  where+    arr' = compute @r (zoomWithGrid defVal stride arr)+    sz' = Sz (liftIndex (subtract 1) $ unSz (size arr'))+    stride' = Stride (liftIndex (+ 1) $ unStride stride)++prop_ZoomStrideCompute ::+     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), StrideLoad r ix e, Mutable r ix e)+  => Array r ix e+  -> Stride ix+  -> Property+prop_ZoomStrideCompute arr stride = computeWithStride @r stride arr' === compute arr+  where+    arr' = compute @r (zoom stride arr)+++type Transform r ix e+   = ( Show e+     , Eq e+     , Arbitrary e+     , Arbitrary ix+     , Typeable e+     , Typeable ix+     , CoArbitrary e+     , CoArbitrary ix+     , Function e+     , Function ix+     , Eq (Array r ix e)+     , Eq (Array (R r) ix e)+     , Eq (Array r ix Int)+     , Show (Array r ix e)+     , Show (Array (R r) ix e)+     , Show (Array r ix Int)+     , NFData (Array r ix e)+     , NFData (Array r Int e)+     , Resize r ix+     , Extract r ix e+     , Source (R r) ix e+     , StrideLoad r ix e+     , StrideLoad (R r) ix e+     , Mutable r ix Int+     , Mutable r ix e)++specTransformR ::+     forall r ix e. Transform r ix e+  => Spec+specTransformR =+  describe ("Transform (" ++ showsArrayType @r @ix @e ")") $ do+    prop "UpsampleDownsample" (prop_UpsampleDownsample @r @ix @e)+    prop "ExtractSizeMismatch" (prop_ExtractSizeMismatch @r @ix @e)+    prop "ExtractAppend" (prop_ExtractAppend @r @ix @e)+    prop "SplitExtract" (prop_SplitExtract @r @ix @e)+    prop "ConcatAppend" (prop_ConcatAppend @r @ix)+    prop "ConcatMConcatOuterM" (prop_ConcatMConcatOuterM @r @ix)+    prop "ZoomStrideCompute" (prop_ZoomStrideCompute @r @ix @e)+    prop "ZoomWithGridStrideCompute" (prop_ZoomWithGridStrideCompute @r @ix @e)++spec :: Spec+spec = do+  it "transposeOuterInner" $ property prop_TransposeOuterInner+  specTransformR @P @Ix1 @Int+  specTransformR @P @Ix2 @Int+  specTransformR @P @Ix3 @Int+  specTransformR @P @Ix4 @Int+  describe "Monoid" $ do+    it "Ix1" $ property prop_AppendMappend+    it "Ix1" $ property prop_ConcatMconcat+  describe "Sequence" $ do+    it "ConsSnoc" $ property prop_ConsSnoc+    it "UnconsUnsnoc" $ property prop_UnconsUnsnoc+++prop_UnconsUnsnoc :: Array D Ix1 Int -> Bool -> Property+prop_UnconsUnsnoc arr unconsFirst =+  preJust $ do+    (arr', u, s) <-+      if unconsFirst+        then do+          (u, au) <- unconsM arr+          (as, s) <- unsnocM au+          pure (as, u, s)+        else do+          (as, s) <- unsnocM arr+          (u, au) <- unconsM as+          pure (au, u, s)+    pure (computeAs U (A.snoc (A.cons u (toLoadArray (computeAs U arr'))) s) === compute arr)++preJust :: Testable prop => Maybe prop -> Property+preJust m = isJust m ==> fromJust m++prop_ConsSnoc :: Array D Ix1 Int -> [SeqOp Int] -> Property+prop_ConsSnoc arr ops =+  A.toList (computeAs U (foldl' applyArraySeqOp (toLoadArray arr) ops)) ===+  F.toList (foldl' applySequenceSeqOp (S.fromList (A.toList arr)) ops)++data SeqOp e = Cons e | Snoc e deriving (Eq, Show)++instance Arbitrary e => Arbitrary (SeqOp e) where+  arbitrary = do+    e <- arbitrary+    elements [Cons e, Snoc e]++applyArraySeqOp :: Array DL Ix1 e -> SeqOp e -> Array DL Ix1 e+applyArraySeqOp arr = \case+  Cons x -> A.cons x arr+  Snoc x -> A.snoc arr x+++applySequenceSeqOp :: Seq a -> SeqOp a -> Seq a+applySequenceSeqOp arr = \case+  Cons x -> x <| arr+  Snoc x -> arr |> x

@@ -1,7 +1,9 @@-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Test.Massiv.Core.IndexSpec (spec) where @@ -14,7 +16,6 @@ import Test.Validity.Ord (ordSpecOnArbitrary)  - specIxN ::      forall ix.      ( Num ix@@ -26,6 +27,7 @@      , Typeable (Lower ix)      , Arbitrary ix      , Arbitrary (Lower ix)+     , IsIndexDimension ix (Dimensions ix)      )   => Spec specIxN = do@@ -70,6 +72,7 @@      , Index (Lower ix)      , Arbitrary ix      , Arbitrary (Lower ix)+     , IsIndexDimension ix (Dimensions ix)      )   => (ix -> ix')   -> (ix' -> ix)