massiv-test 0.1.3 → 0.1.3.1
raw patch · 8 files changed
+1571/−574 lines, 8 filesdep ~massiv
Dependency ranges changed: massiv
Files
- massiv-test.cabal +7/−6
- tests/Data/Massiv/Array/Numeric/IntegralSpec.hs +0/−37
- tests/Data/Massiv/Array/Ops/MapSpec.hs +0/−126
- tests/Data/Massiv/Array/StencilSpec.hs +0/−285
- tests/Test/Massiv/Array/Numeric/IntegralSpec.hs +37/−0
- tests/Test/Massiv/Array/Ops/MapSpec.hs +127/−0
- tests/Test/Massiv/Array/StencilSpec.hs +283/−0
- tests/Test/Massiv/VectorSpec.hs +1117/−120
massiv-test.cabal view
@@ -1,5 +1,5 @@ name: massiv-test-version: 0.1.3+version: 0.1.3.1 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@@ -15,7 +15,7 @@ cabal-version: >=1.10 library- hs-source-dirs: src+ hs-source-dirs: src exposed-modules: Test.Massiv.Core , Test.Massiv.Core.Common , Test.Massiv.Core.Index@@ -57,6 +57,9 @@ , Test.Massiv.Array.MutableSpec , Test.Massiv.Array.Ops.TransformSpec , Test.Massiv.Array.Ops.SortSpec+ , Test.Massiv.Array.Ops.MapSpec+ , Test.Massiv.Array.Numeric.IntegralSpec+ , Test.Massiv.Array.StencilSpec , Test.Massiv.VectorSpec -- TODO: Below should be moved to Test.Massiv.Array , Data.Massiv.Array.Delayed.InterleavedSpec@@ -65,12 +68,9 @@ , Data.Massiv.Array.DelayedSpec , Data.Massiv.Array.Manifest.VectorSpec , Data.Massiv.Array.ManifestSpec- , Data.Massiv.Array.Numeric.IntegralSpec , Data.Massiv.Array.Ops.ConstructSpec , Data.Massiv.Array.Ops.FoldSpec- , Data.Massiv.Array.Ops.MapSpec , Data.Massiv.Array.Ops.SliceSpec- , Data.Massiv.Array.StencilSpec , Data.Massiv.ArraySpec build-depends: base , bytestring@@ -78,10 +78,11 @@ , data-default , deepseq , genvalidity-hspec- , massiv+ , massiv >= 0.5.2 , massiv-test , mwc-random , hspec+ , primitive , scheduler , QuickCheck , vector
− tests/Data/Massiv/Array/Numeric/IntegralSpec.hs
@@ -1,37 +0,0 @@-module Data.Massiv.Array.Numeric.IntegralSpec- ( spec- ) where--import Data.Massiv.Array as A-import Data.Massiv.Array.Numeric.Integral-import Test.Hspec--gaussian :: Float -> Float-gaussian x = exp (x ^ (2 :: Int))--spec :: Spec-spec = do- let (a, b) = (0, 2)- integrator rule = rule Seq N (\ scale -> gaussian . scale) a b (Sz1 1)- describe "Integral Approximation" $ do- it "Midpoint Rule" $ do- integrator midpointRule 4 ! 0 `shouldBe` 14.485613- integrator midpointRule 8 ! 0 `shouldBe` 15.905677- integrator midpointRule 16 ! 0 `shouldBe` 16.311854- integrator midpointRule 32 ! 0 `shouldBe` 16.417171- integrator midpointRule 64 ! 0 `shouldBe` 16.443748- integrator midpointRule 128 ! 0 `shouldBe` 16.450407- it "Trapezoid Rule" $ do- integrator trapezoidRule 4 ! 0 `shouldBe` 20.644558- integrator trapezoidRule 8 ! 0 `shouldBe` 17.565086- integrator trapezoidRule 16 ! 0 `shouldBe` 16.735381- integrator trapezoidRule 32 ! 0 `shouldBe` 16.523618- integrator trapezoidRule 64 ! 0 `shouldBe` 16.470394- integrator trapezoidRule 128 ! 0 `shouldBe` 16.457073- it "Simspon's Rule" $ do- integrator simpsonsRule 4 ! 0 `shouldBe` 17.353626- integrator simpsonsRule 8 ! 0 `shouldBe` 16.538595- integrator simpsonsRule 16 ! 0 `shouldBe` 16.458815- integrator simpsonsRule 32 ! 0 `shouldBe` 16.453030- integrator simpsonsRule 64 ! 0 `shouldBe` 16.452653- integrator simpsonsRule 128 ! 0 `shouldBe` 16.452629
− tests/Data/Massiv/Array/Ops/MapSpec.hs
@@ -1,126 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-module Data.Massiv.Array.Ops.MapSpec (spec) where--import Data.IORef-import Control.Monad.ST-import Data.Foldable as F-import Data.Massiv.Array.Unsafe-import Data.Massiv.Array as A-import Test.Massiv.Core-import Prelude as P-import Control.Scheduler.Internal--prop_zipUnzip ::- (Index ix, Show (Array D ix Int))- => Array D ix Int- -> Array D ix Int- -> Property-prop_zipUnzip arr1 arr2 =- (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2) === A.unzip (A.zip arr1 arr2)- where sz = Sz (liftIndex2 min (unSz (size arr1)) (unSz (size arr2)))--prop_zipFlip ::- (Index ix, Show (Array D ix (Int, Int)))- => Array D ix Int- -> Array D ix Int- -> Property-prop_zipFlip arr1 arr2 =- A.zip arr1 arr2 ===- A.map (\(e2, e1) -> (e1, e2)) (A.zip arr2 arr1)--prop_zipUnzip3 ::- (Index ix, Show (Array D ix Int))- => Array D ix Int- -> Array D ix Int- -> Array D ix Int- -> Property-prop_zipUnzip3 arr1 arr2 arr3 =- (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2, extract' zeroIndex sz arr3) ===- A.unzip3 (A.zip3 arr1 arr2 arr3)- where- sz =- Sz (liftIndex2 min (liftIndex2 min (unSz (size arr1)) (unSz (size arr2))) (unSz (size arr3)))--prop_zipFlip3 ::- (Index ix, Show (Array D ix (Int, Int, Int)))- => Array D ix Int- -> Array D ix Int- -> Array D ix Int- -> Property-prop_zipFlip3 arr1 arr2 arr3 =- A.zip3 arr1 arr2 arr3 === A.map (\(e3, e2, e1) -> (e1, e2, e3)) (A.zip3 arr3 arr2 arr1)----prop_itraverseA ::- (Index ix, Show (Array U ix Int)) => Array D ix Int -> Fun (ix, Int) Int -> Property-prop_itraverseA arr fun =- alt_imapM (\ix -> Just . applyFun2Compat fun ix) arr ===- itraverseA @U (\ix -> Just . applyFun2Compat fun ix) arr---mapSpec ::- forall ix.- ( Arbitrary ix- , CoArbitrary ix- , Index ix- , Function ix- , Show (Array U ix Int)- , Show (Array D ix Int)- , Show (Array D ix (Int, Int))- , Show (Array D ix (Int, Int, Int))- )- => Spec-mapSpec = do- describe "Zipping" $ do- it "zipUnzip" $ property $ prop_zipUnzip @ix- it "zipFlip" $ property $ prop_zipFlip @ix- it "zipUnzip3" $ property $ prop_zipUnzip3 @ix- it "zipFlip3" $ property $ prop_zipFlip3 @ix- describe "Traversing" $- it "itraverseA" $ property $ prop_itraverseA @ix- describe "StatefulMapping" $- it "mapWS" $ property $ prop_MapWS @ix--spec :: Spec-spec = do- describe "Ix1" $ mapSpec @Ix1- describe "Ix2" $ mapSpec @Ix2- describe "Ix3" $ mapSpec @Ix3- describe "Ix4" $ mapSpec @Ix4----alt_imapM- :: (Applicative f, Mutable r2 t1 b, Source r1 t1 t2) =>- (t1 -> t2 -> f b) -> Array r1 t1 t2 -> f (Array r2 t1 b)-alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (zipWithIndex arr)- where- loadList xs =- runST $ do- marr <- unsafeNew (size arr)- _ <- F.foldlM (\i e -> unsafeLinearWrite marr i e >> return (i + 1)) 0 xs- unsafeFreeze (getComp arr) marr- {-# INLINE loadList #-}--zipWithIndex :: forall r ix e . Source r ix e => Array r ix e -> Array D ix (ix, e)-zipWithIndex arr = A.zip (range Seq zeroIndex (unSz (size arr))) arr-{-# INLINE zipWithIndex #-}---prop_MapWS :: (Show (Array U ix Int), Index ix) => Array U ix Int -> Property-prop_MapWS arr =- monadicIO $- run $ do- states <- initWorkerStates (getComp arr) (\_ -> newIORef 0)- arr' <-- forWS states arr $ \e ref -> do- acc <- readIORef ref- writeIORef ref (acc + e)- pure e- accsArr <- A.mapM @P readIORef (evalArray Seq (_workerStatesArray states))- pure (A.sum arr' === A.sum accsArr .&&. arr === arr')
− tests/Data/Massiv/Array/StencilSpec.hs
@@ -1,285 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# 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.Unsafe as A-import Test.Massiv.Core--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)---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)--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) ===- computeAs U (A.map (apply f) arr)---- Tests out of bounds stencil indexing-prop_DangerousStencil ::- Index ix => Proxy ix -> NonZero Int -> DimIx ix -> SzIx ix -> Property-prop_DangerousStencil _ (NonZero s) (DimIx r) (SzIx sz ix) =- ix' `deepseq` assertSomeException $ makeStencil sz ix $ \get -> get ix' :: Value Int- where- 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 (unsafeMapStencil b sz zeroIndex (const g) arr) ===- computeAs P (applyStencil (samePadding stencil b) stencil arr) .&&.- computeWithStrideAs P stride (unsafeMapStencil b sz zeroIndex (const 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- it "Ix1" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix1)- it "Ix2" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2)- it "Ix3" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix3)- it "Ix4" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix4)- it "Ix2T" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2T)- describe "MapSingletonStencilWithStride" $ do- 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)---stencilCorners :: Ix2 -> Ix2 -> Array U Ix2 Int -> Array U Ix2 Int-stencilCorners ixC ix = computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) ixC $ \f -> f ix)---stencilConvolution :: Spec-stencilConvolution = do- let xs3 :: Array U Ix1 Int- xs3 = [1, 2, 3]- xs3f f = f (-1) 1 . f 0 2 . f 1 3- xs4 :: Array U Ix1 Int- xs4 = [1, 2, 3, 4]- xs4f f = f (-2) 1 . f (-1) 2 . f 0 3 . f 1 4- ys :: Array U Ix1 Int- ys = [1, 2, 3, 4, 5]- ysConvXs3 = [4, 10, 16, 22, 22]- ysConvXs4 = [10, 20, 30, 34, 31]- ysCorrXs3 = [8, 14, 20, 26, 14]- ysCorrXs4 = [11, 20, 30, 40, 26]- 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 . applyStencil noPadding s- describe "makeConvolutionStencilFromKernel" $ do- 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 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3- it "1x4 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4- describe "makeConvolutionStencil" $ do- 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" $ 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) ->- mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr ===- mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr- it "1x3" $- property $ \(arr :: Array U Ix1 Int) ->- mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr ===- mapStencil1 (makeConvolutionStencilFromKernel xs3) arr- it "1x4" $- property $ \(arr :: Array U Ix1 Int) ->- mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr ===- mapStencil1 (makeConvolutionStencilFromKernel xs4) arr- describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do- it "Sobel Horizontal" $- property $ \(arr :: Array U Ix2 Int) ->- mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr ===- mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr- it "1x3" $- property $ \(arr :: Array U Ix1 Int) ->- mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr ===- mapStencil1 (makeCorrelationStencilFromKernel xs3) arr- it "1x4" $- property $ \(arr :: Array U Ix1 Int) ->- 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) ->- mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr ===- mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr- it "1x3" $- property $ \(arr :: Array U Ix1 Int) ->- mapStencil1 (makeConvolutionStencilFromKernel xs3) arr ===- mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr- it "1x5" $- property $ \(arr :: Array U Ix1 Int) ->- mapStencil1 (makeConvolutionStencilFromKernel ys) arr ===- mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr--spec :: Spec-spec = do- describe "Stencil" $ do- stencilSpec- let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array U Ix2 Int- describe "Unit tests Ix2" $ do- it "Direction Left" $- stencilDirection (0 :. 1) arr `shouldBe` [[2, 3, 0], [5, 6, 0], [8, 9, 0]]- it "Direction Right" $- stencilDirection (0 :. -1) arr `shouldBe` [[0, 1, 2], [0, 4, 5], [0, 7, 8]]- it "Direction Down" $- stencilDirection (1 :. 0) arr `shouldBe` [[4, 5, 6], [7, 8, 9], [0, 0, 0]]- it "Direction Up" $- stencilDirection (-1 :. 0) arr `shouldBe` [[0, 0, 0], [1, 2, 3], [4, 5, 6]]- it "Direction Left/Top Corner" $- stencilCorners (0 :. 0) (2 :. 2) arr `shouldBe` [[9, 0, 0], [0, 0, 0], [0, 0, 0]]- it "Direction Right/Top Corner" $- stencilCorners (0 :. 2) (2 :. -2) arr `shouldBe` [[0, 0, 7], [0, 0, 0], [0, 0, 0]]- it "Direction Right/Bottom Corner" $- stencilCorners (2 :. 2) (-2 :. -2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [0, 0, 1]]- it "Direction Left/Bottom Corner" $- stencilCorners (2 :. 0) (-2 :. 2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [3, 0, 0]]- describe "mapStencil with stride" $ do- let kernel = [[-1, 0, 1], [0, 1, 0], [-1, 0, 1]] :: Array U Ix2 Int- stencil = makeConvolutionStencilFromKernel kernel- stride = Stride 2- it "map stencil with stride on small array" $- let strideArr = mapStencil (Fill 0) stencil arr- in computeWithStrideAs U stride strideArr `shouldBe` [[-4, 8], [2, 14]]- it "map stencil with stride on larger array" $- let largeArr = makeArrayR U Seq (Sz 5) (succ . toLinearIndex (Sz 5))- strideArr = mapStencil (Fill 0) stencil largeArr- in computeWithStrideAs U stride strideArr `shouldBe`- [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]]- stencilConvolution--sobelX :: Num e => (Ix2 -> e -> e -> e) -> e -> e-sobelX f = f (-1 :. -1) (-1) . f (-1 :. 1) 1 .- f ( 0 :. -1) (-2) . f ( 0 :. 1) 2 .- f ( 1 :. -1) (-1) . f ( 1 :. 1) 1--sobelKernelX :: Array U Ix2 Int-sobelKernelX = [ [-1, 0, 1]- , [-2, 0, 2]- , [-1, 0, 1] ]--rotate180 :: (Num ix, Index ix) => Array U ix Int -> Array U ix Int-rotate180 = computeAs U . transform' (\sz -> (sz, sz)) (\(Sz sz) f ix -> f (sz - 1 - ix))
+ tests/Test/Massiv/Array/Numeric/IntegralSpec.hs view
@@ -0,0 +1,37 @@+module Test.Massiv.Array.Numeric.IntegralSpec+ ( spec+ ) where++import Data.Massiv.Array as A+import Data.Massiv.Array.Numeric.Integral+import Test.Massiv.Core++gaussian :: Float -> Float+gaussian x = exp (x ^ (2 :: Int))++spec :: Spec+spec = do+ let (a, b) = (0, 2)+ integrator rule = rule Seq N (\ s -> gaussian . s) a b (Sz1 1)+ describe "Integral Approximation" $ do+ it "Midpoint Rule" $ do+ integrator midpointRule 4 ! 0 `shouldBe` 14.485613+ integrator midpointRule 8 ! 0 `shouldBe` 15.905677+ integrator midpointRule 16 ! 0 `shouldBe` 16.311854+ integrator midpointRule 32 ! 0 `shouldBe` 16.417171+ integrator midpointRule 64 ! 0 `shouldBe` 16.443748+ integrator midpointRule 128 ! 0 `shouldBe` 16.450407+ it "Trapezoid Rule" $ do+ integrator trapezoidRule 4 ! 0 `shouldBe` 20.644558+ integrator trapezoidRule 8 ! 0 `shouldBe` 17.565086+ integrator trapezoidRule 16 ! 0 `shouldBe` 16.735381+ integrator trapezoidRule 32 ! 0 `shouldBe` 16.523618+ integrator trapezoidRule 64 ! 0 `shouldBe` 16.470394+ integrator trapezoidRule 128 ! 0 `shouldBe` 16.457073+ it "Simspon's Rule" $ do+ integrator simpsonsRule 4 ! 0 `shouldBe` 17.353626+ integrator simpsonsRule 8 ! 0 `shouldBe` 16.538595+ integrator simpsonsRule 16 ! 0 `shouldBe` 16.458815+ integrator simpsonsRule 32 ! 0 `shouldBe` 16.453030+ integrator simpsonsRule 64 ! 0 `shouldBe` 16.452653+ integrator simpsonsRule 128 ! 0 `shouldBe` 16.452629
+ tests/Test/Massiv/Array/Ops/MapSpec.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Array.Ops.MapSpec (spec) where++import Control.Monad.ST+import Data.Foldable as F+import Data.Massiv.Array.Unsafe+import Data.Massiv.Array as A+import Test.Massiv.Core+import Prelude as P+import Control.Scheduler++prop_zipUnzip ::+ (Index ix, Show (Array D ix Int))+ => Array D ix Int+ -> Array D ix Int+ -> Property+prop_zipUnzip arr1 arr2 =+ (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2) === A.unzip (A.zip arr1 arr2)+ where sz = Sz (liftIndex2 min (unSz (size arr1)) (unSz (size arr2)))++prop_zipFlip ::+ (Index ix, Show (Array D ix (Int, Int)))+ => Array D ix Int+ -> Array D ix Int+ -> Property+prop_zipFlip arr1 arr2 =+ A.zip arr1 arr2 ===+ A.map (\(e2, e1) -> (e1, e2)) (A.zip arr2 arr1)++prop_zipUnzip3 ::+ (Index ix, Show (Array D ix Int))+ => Array D ix Int+ -> Array D ix Int+ -> Array D ix Int+ -> Property+prop_zipUnzip3 arr1 arr2 arr3 =+ (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2, extract' zeroIndex sz arr3) ===+ A.unzip3 (A.zip3 arr1 arr2 arr3)+ where+ sz =+ Sz (liftIndex2 min (liftIndex2 min (unSz (size arr1)) (unSz (size arr2))) (unSz (size arr3)))++prop_zipFlip3 ::+ (Index ix, Show (Array D ix (Int, Int, Int)))+ => Array D ix Int+ -> Array D ix Int+ -> Array D ix Int+ -> Property+prop_zipFlip3 arr1 arr2 arr3 =+ A.zip3 arr1 arr2 arr3 === A.map (\(e3, e2, e1) -> (e1, e2, e3)) (A.zip3 arr3 arr2 arr1)++++prop_itraverseA ::+ (Index ix, Show (Array U ix Int)) => Array D ix Int -> Fun (ix, Int) Int -> Property+prop_itraverseA arr fun =+ alt_imapM (\ix -> Just . applyFun2Compat fun ix) arr ===+ itraverseA @U (\ix -> Just . applyFun2Compat fun ix) arr+++mapSpec ::+ forall ix.+ ( Arbitrary ix+ , CoArbitrary ix+ , Index ix+ , Function ix+ , Show (Array U ix Int)+ , Show (Array D ix Int)+ , Show (Array D ix (Int, Int))+ , Show (Array D ix (Int, Int, Int))+ )+ => Spec+mapSpec = do+ describe "Zipping" $ do+ it "zipUnzip" $ property $ prop_zipUnzip @ix+ it "zipFlip" $ property $ prop_zipFlip @ix+ it "zipUnzip3" $ property $ prop_zipUnzip3 @ix+ it "zipFlip3" $ property $ prop_zipFlip3 @ix+ describe "Traversing" $+ it "itraverseA" $ property $ prop_itraverseA @ix+ describe "StatefulMapping" $+ it "mapWS" $ property $ prop_MapWS @ix++spec :: Spec+spec = do+ describe "Ix1" $ mapSpec @Ix1+ describe "Ix2" $ mapSpec @Ix2+ describe "Ix3" $ mapSpec @Ix3+ describe "Ix4" $ mapSpec @Ix4++++alt_imapM+ :: (Applicative f, Mutable r2 t1 b, Source r1 t1 t2) =>+ (t1 -> t2 -> f b) -> Array r1 t1 t2 -> f (Array r2 t1 b)+alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (zipWithIndex arr)+ where+ loadList xs =+ runST $ do+ marr <- unsafeNew (size arr)+ _ <- F.foldlM (\i e -> unsafeLinearWrite marr i e >> return (i + 1)) 0 xs+ unsafeFreeze (getComp arr) marr+ {-# INLINE loadList #-}++zipWithIndex :: forall r ix e . Source r ix e => Array r ix e -> Array D ix (ix, e)+zipWithIndex arr = A.zip (range Seq zeroIndex (unSz (size arr))) arr+{-# INLINE zipWithIndex #-}+++prop_MapWS :: (Show (Array U ix Int), Index ix) => Array U ix Int -> Property+prop_MapWS arr =+ monadicIO $+ run $ do+ let comp = getComp arr+ count <- getCompWorkers comp+ arrStates <- new @P (Sz count)+ states <- initWorkerStates comp (\(WorkerId i) -> pure $ \f -> modifyM_ arrStates f i)+ arr' <-+ forWS states arr $ \e smod -> do+ smod $ \acc -> pure (acc + e)+ pure e+ accsArr <- freeze Seq arrStates+ pure (A.sum arr' === A.sum accsArr .&&. arr === arr')
+ tests/Test/Massiv/Array/StencilSpec.hs view
@@ -0,0 +1,283 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Array.StencilSpec (spec) where++import Prelude as P+import Data.Massiv.Array as A+import Data.Massiv.Array.Unsafe as A+import Test.Massiv.Core++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)+++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)++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) ===+ computeAs U (A.map (apply f) arr)++-- Tests out of bounds stencil indexing+prop_DangerousStencil ::+ Index ix => Proxy ix -> NonZero Int -> DimIx ix -> SzIx ix -> Property+prop_DangerousStencil _ (NonZero s) (DimIx r) (SzIx sz ix) =+ ix' `deepseq` assertSomeException $ makeStencil sz ix $ \get -> get ix' :: Value Int+ where+ 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 (unsafeMapStencil b sz zeroIndex (const g) arr) ===+ computeAs P (applyStencil (samePadding stencil b) stencil arr) .&&.+ computeWithStrideAs P stride (unsafeMapStencil b sz zeroIndex (const 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+ it "Ix1" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix1)+ it "Ix2" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2)+ it "Ix3" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix3)+ it "Ix4" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix4)+ it "Ix2T" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2T)+ describe "MapSingletonStencilWithStride" $ do+ 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)+++stencilCorners :: Ix2 -> Ix2 -> Array U Ix2 Int -> Array U Ix2 Int+stencilCorners ixC ix = computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) ixC $ \f -> f ix)+++stencilConvolution :: Spec+stencilConvolution = do+ let xs3 :: Array U Ix1 Int+ xs3 = [1, 2, 3]+ xs3f f = f (-1) 1 . f 0 2 . f 1 3+ xs4 :: Array U Ix1 Int+ xs4 = [1, 2, 3, 4]+ xs4f f = f (-2) 1 . f (-1) 2 . f 0 3 . f 1 4+ ys :: Array U Ix1 Int+ ys = [1, 2, 3, 4, 5]+ ysConvXs3 = [4, 10, 16, 22, 22]+ ysConvXs4 = [10, 20, 30, 34, 31]+ ysCorrXs3 = [8, 14, 20, 26, 14]+ ysCorrXs4 = [11, 20, 30, 40, 26]+ 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 . applyStencil noPadding s+ describe "makeConvolutionStencilFromKernel" $ do+ 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 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3+ it "1x4 map" $ mapStencil1 (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4+ describe "makeConvolutionStencil" $ do+ 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" $ 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) ->+ mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr ===+ mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr+ it "1x3" $+ property $ \(arr :: Array U Ix1 Int) ->+ mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr ===+ mapStencil1 (makeConvolutionStencilFromKernel xs3) arr+ it "1x4" $+ property $ \(arr :: Array U Ix1 Int) ->+ mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr ===+ mapStencil1 (makeConvolutionStencilFromKernel xs4) arr+ describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do+ it "Sobel Horizontal" $+ property $ \(arr :: Array U Ix2 Int) ->+ mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr ===+ mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr+ it "1x3" $+ property $ \(arr :: Array U Ix1 Int) ->+ mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr ===+ mapStencil1 (makeCorrelationStencilFromKernel xs3) arr+ it "1x4" $+ property $ \(arr :: Array U Ix1 Int) ->+ 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) ->+ mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr ===+ mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr+ it "1x3" $+ property $ \(arr :: Array U Ix1 Int) ->+ mapStencil1 (makeConvolutionStencilFromKernel xs3) arr ===+ mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr+ it "1x5" $+ property $ \(arr :: Array U Ix1 Int) ->+ mapStencil1 (makeConvolutionStencilFromKernel ys) arr ===+ mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr++spec :: Spec+spec = do+ describe "Stencil" $ do+ stencilSpec+ let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array U Ix2 Int+ describe "Unit tests Ix2" $ do+ it "Direction Left" $+ stencilDirection (0 :. 1) arr `shouldBe` [[2, 3, 0], [5, 6, 0], [8, 9, 0]]+ it "Direction Right" $+ stencilDirection (0 :. -1) arr `shouldBe` [[0, 1, 2], [0, 4, 5], [0, 7, 8]]+ it "Direction Down" $+ stencilDirection (1 :. 0) arr `shouldBe` [[4, 5, 6], [7, 8, 9], [0, 0, 0]]+ it "Direction Up" $+ stencilDirection (-1 :. 0) arr `shouldBe` [[0, 0, 0], [1, 2, 3], [4, 5, 6]]+ it "Direction Left/Top Corner" $+ stencilCorners (0 :. 0) (2 :. 2) arr `shouldBe` [[9, 0, 0], [0, 0, 0], [0, 0, 0]]+ it "Direction Right/Top Corner" $+ stencilCorners (0 :. 2) (2 :. -2) arr `shouldBe` [[0, 0, 7], [0, 0, 0], [0, 0, 0]]+ it "Direction Right/Bottom Corner" $+ stencilCorners (2 :. 2) (-2 :. -2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [0, 0, 1]]+ it "Direction Left/Bottom Corner" $+ stencilCorners (2 :. 0) (-2 :. 2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [3, 0, 0]]+ describe "mapStencil with stride" $ do+ let kernel = [[-1, 0, 1], [0, 1, 0], [-1, 0, 1]] :: Array U Ix2 Int+ stencil = makeConvolutionStencilFromKernel kernel+ stride = Stride 2+ it "map stencil with stride on small array" $+ let strideArr = mapStencil (Fill 0) stencil arr+ in computeWithStrideAs U stride strideArr `shouldBe` [[-4, 8], [2, 14]]+ it "map stencil with stride on larger array" $+ let largeArr = makeArrayR U Seq (Sz 5) (succ . toLinearIndex (Sz 5))+ strideArr = mapStencil (Fill 0) stencil largeArr+ in computeWithStrideAs U stride strideArr `shouldBe`+ [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]]+ stencilConvolution++sobelX :: Num e => (Ix2 -> e -> e -> e) -> e -> e+sobelX f = f (-1 :. -1) (-1) . f (-1 :. 1) 1 .+ f ( 0 :. -1) (-2) . f ( 0 :. 1) 2 .+ f ( 1 :. -1) (-1) . f ( 1 :. 1) 1++sobelKernelX :: Array U Ix2 Int+sobelKernelX = [ [-1, 0, 1]+ , [-2, 0, 2]+ , [-1, 0, 1] ]++rotate180 :: (Num ix, Index ix) => Array U ix Int -> Array U ix Int+rotate180 = computeAs U . transform' (\sz -> (sz, sz)) (\(Sz sz) f ix -> f (sz - 1 - ix))
tests/Test/Massiv/VectorSpec.hs view
@@ -1,123 +1,1120 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-module Test.Massiv.VectorSpec (spec) where--import Control.Exception-import Data.Bits-import Data.Massiv.Array as A-import Data.Massiv.Vector as V-import qualified Data.Vector.Primitive as VP-import Data.Word-import Test.Massiv.Core--import System.Random.MWC as MWC--infix 4 !==!, !!==!!--sizeException :: SizeException -> Bool-sizeException _ = True--(!==!) :: (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property-(!==!) arr vec = toPrimitiveVector (convert arr) === vec--(!!==!!) :: (Eq e, Show e, Prim e, Source r Ix1 e) => V.Vector r e -> VP.Vector e -> Property-(!!==!!) arr vec = property $ do- eRes <- try (pure $! vec)- case eRes of- Right vec' -> toPrimitiveVector (computeSource arr) `shouldBe` vec'- Left (_exc :: ErrorCall) ->- shouldThrow (pure $! toPrimitiveVector (computeSource arr)) sizeException--newtype SeedVector = SeedVector (VP.Vector Word32) deriving (Eq, Show)--instance Arbitrary SeedVector where- arbitrary = SeedVector . VP.fromList <$> arbitrary--withSeed :: forall a. SeedVector -> (forall s. MWC.Gen s -> ST s a) -> a-withSeed (SeedVector seed) f = runST $ do- gen <- MWC.initialize seed- f gen--prop_sreplicateM :: SeedVector -> Int -> Property-prop_sreplicateM seed k =- withSeed @(V.Vector DS Word) seed (V.sreplicateM (Sz k) . uniform)- !==! withSeed seed (VP.replicateM k . uniform)--prop_sgenerateM :: SeedVector -> Int -> Fun Int Word -> Property-prop_sgenerateM seed k f =- withSeed @(V.Vector DS Word) seed (genWith (V.sgenerateM (Sz k)))- !==! withSeed seed (genWith (VP.generateM k))- where- genWith :: PrimMonad f => ((Int -> f Word) -> t) -> MWC.Gen (PrimState f) -> t- genWith genM gen = genM (\i -> xor (apply f i) <$> uniform gen)---prop_siterateNM :: SeedVector -> Int -> Word -> Property-prop_siterateNM seed k a =- withSeed @(V.Vector DS Word) seed (genWith (\action -> V.siterateNM (Sz k) action a))- !==! withSeed seed (genWith (\action -> VP.iterateNM k action a))- where- genWith :: PrimMonad f => ((Word -> f Word) -> t) -> MWC.Gen (PrimState f) -> t- genWith genM gen = genM (\prev -> xor prev <$> uniform gen)---spec :: Spec-spec = do- describe "Vector" $ do- describe "same-as-vector-package" $ do- describe "Accessors" $ do- describe "Slicing" $ do- prop "slice'" $ \i sz (arr :: Array P Ix1 Word) ->- V.slice' i sz arr !!==!! VP.slice i (unSz sz) (toPrimitiveVector arr)- prop "init'" $ \(arr :: Array P Ix1 Word) ->- V.init' arr !!==!! VP.init (toPrimitiveVector arr)- prop "tail'" $ \(arr :: Array P Ix1 Word) ->- V.tail' arr !!==!! VP.tail (toPrimitiveVector arr)- prop "take" $ \n (arr :: Array P Ix1 Word) ->- V.take (Sz n) arr !==! VP.take n (toPrimitiveVector arr)- prop "stake" $ \n (arr :: Array P Ix1 Word) ->- V.stake (Sz n) arr !==! VP.take n (toPrimitiveVector arr)- prop "drop" $ \n (arr :: Array P Ix1 Word) ->- V.drop (Sz n) arr !==! VP.drop n (toPrimitiveVector arr)- prop "sdrop" $ \n (arr :: Array P Ix1 Word) ->- V.sdrop (Sz n) arr !==! VP.drop n (toPrimitiveVector arr)- prop "sliceAt" $ \sz (arr :: Array P Ix1 Word) ->- let (larr, rarr) = V.sliceAt (Sz sz) arr- (lvec, rvec) = VP.splitAt sz (toPrimitiveVector arr)- in (larr !==! lvec) .&&. (rarr !==! rvec)- describe "Constructors" $ do- describe "Initialization" $ do- it "empty" $ toPrimitiveVector (V.empty :: V.Vector P Word) `shouldBe` VP.empty- prop "singleton" $ \e -> (V.singleton e :: V.Vector P Word) !==! VP.singleton e- prop "ssingleton" $ \(e :: Word) -> V.ssingleton e !==! VP.singleton e- prop "replicate" $ \comp k (e :: Word) -> V.replicate comp (Sz k) e !==! VP.replicate k e- prop "sreplicate" $ \k (e :: Word) -> V.sreplicate (Sz k) e !==! VP.replicate k e- prop "generate" $ \comp k (f :: Fun Int Word) ->- V.generate comp (Sz k) (apply f) !==! VP.generate k (apply f)- prop "sgenerate" $ \k (f :: Fun Int Word) ->- V.sgenerate (Sz k) (apply f) !==! VP.generate k (apply f)- prop "siterateN" $ \n (f :: Fun Word Word) a ->- V.siterateN (Sz n) (apply f) a !==! VP.iterateN n (apply f) a- describe "Monadic initialization" $ do- prop "sreplicateM" prop_sreplicateM- prop "sgenerateM" prop_sgenerateM- prop "siterateNM" prop_siterateNM- describe "Unfolding" $ do- prop "sunfoldr" $ \(a :: Word) ->- let f b- | b > 10000 || b `div` 17 == 0 = Nothing- | otherwise = Just (b * b, b + 1)- in V.sunfoldr f a !==! VP.unfoldr f a- prop "sunfoldrN" $ \n (a :: Word) ->- let f b- | b > 10000 || b `div` 19 == 0 = Nothing- | otherwise = Just (b * b, b + 1)- in V.sunfoldrN (Sz n) f a !==! VP.unfoldrN n f a+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Test.Massiv.VectorSpec (spec) where++import Control.Arrow (first)+import Control.Applicative+import Control.DeepSeq+import Control.Exception+import Data.Bits+import Data.Int+import qualified Data.Tuple as Tuple+import qualified Data.List as List+import Data.Massiv.Array as A+import Data.Massiv.Array.Unsafe as A+import Data.Massiv.Vector as V+import Data.Maybe+import Data.Primitive.MutVar+import qualified Data.Vector as VB+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import Data.Word+import Test.Massiv.Core++import System.Random.MWC as MWC++infix 4 !==!, !!==!!++sizeException :: SizeException -> Bool+sizeException exc = exc `deepseq` True++toUnboxV2 ::+ Unbox e1+ => (VU.Vector e2 -> VU.Vector e3 -> VU.Vector e1)+ -> Array U ix1 e2+ -> Array U ix2 e3+ -> Array U Ix1 e1+toUnboxV2 f v1 v2 = fromUnboxedVector (f (toUnboxedVector v1) (toUnboxedVector v2))++toUnboxV3 ::+ Unbox e1+ => (VU.Vector e -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e1)+ -> Array U ix e+ -> Array U ix1 e2+ -> Array U ix2 e3+ -> Array U Ix1 e1+toUnboxV3 f v1 = toUnboxV2 (f (toUnboxedVector v1))++toUnboxV4 ::+ Unbox e1+ => (VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e1)+ -> Array U ix1 e2+ -> Array U ix2 e3+ -> Array U ix3 e4+ -> Array U ix4 e5+ -> Array U Ix1 e1+toUnboxV4 f v1 = toUnboxV3 (f (toUnboxedVector v1))++toUnboxV5 ::+ Unbox e1+ => (VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e6 -> VU.Vector e1)+ -> Array U ix1 e2+ -> Array U ix2 e3+ -> Array U ix3 e4+ -> Array U ix4 e5+ -> Array U ix5 e6+ -> Array U Ix1 e1+toUnboxV5 f v1 = toUnboxV4 (f (toUnboxedVector v1))++toUnboxV6 ::+ Unbox e1+ => (VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e6 -> VU.Vector e7 -> VU.Vector e1)+ -> Array U ix1 e2+ -> Array U ix2 e3+ -> Array U ix3 e4+ -> Array U ix4 e5+ -> Array U ix5 e6+ -> Array U ix6 e7+ -> Array U Ix1 e1+toUnboxV6 f v1 = toUnboxV5 (f (toUnboxedVector v1))++toPrimV2 :: (Index ix) => (VP.Vector e1 -> VP.Vector e2 -> t) -> Array P ix e1 -> Array P ix e2 -> t+toPrimV2 f v1 v2 = f (toPrimitiveVector v1) (toPrimitiveVector v2)++toPrimV3 ::+ Index ix+ => (VP.Vector e -> VP.Vector e1 -> VP.Vector e2 -> t)+ -> Array P ix e+ -> Array P ix e1+ -> Array P ix e2+ -> t+toPrimV3 f v1 = toPrimV2 (f (toPrimitiveVector v1))++toPrimV4 ::+ Index ix+ => (VP.Vector e1 -> VP.Vector e2 -> VP.Vector e3 -> VP.Vector e4 -> t)+ -> Array P ix e1+ -> Array P ix e2+ -> Array P ix e3+ -> Array P ix e4+ -> t+toPrimV4 f v1 = toPrimV3 (f (toPrimitiveVector v1))++toPrimV5 ::+ Index ix+ => (VP.Vector e -> VP.Vector e1 -> VP.Vector e2 -> VP.Vector e3 -> VP.Vector e4 -> t)+ -> Array P ix e+ -> Array P ix e1+ -> Array P ix e2+ -> Array P ix e3+ -> Array P ix e4+ -> t+toPrimV5 f v1 = toPrimV4 (f (toPrimitiveVector v1))++toPrimV6 ::+ Index ix+ => (VP.Vector e -> VP.Vector e1 -> VP.Vector e2 -> VP.Vector e3 -> VP.Vector e4 -> VP.Vector e5 -> t)+ -> Array P ix e+ -> Array P ix e1+ -> Array P ix e2+ -> Array P ix e3+ -> Array P ix e4+ -> Array P ix e5+ -> t+toPrimV6 f v1 = toPrimV5 (f (toPrimitiveVector v1))+++(!==!) :: (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property+(!==!) arr vec = toPrimitiveVector (convert arr) === vec++(!!==!!) :: (Eq e, Show e, Prim e, Source r Ix1 e) => V.Vector r e -> VP.Vector e -> Property+(!!==!!) arr vec = property $ do+ eRes <- try (pure $! vec)+ case eRes of+ Right vec' -> toPrimitiveVector (computeSource arr) `shouldBe` vec'+ Left (_exc :: ErrorCall) ->+ shouldThrow (pure $! computeAs P arr) sizeException++newtype SeedVector = SeedVector (VP.Vector Word32) deriving (Eq, Show)++instance Arbitrary SeedVector where+ arbitrary = SeedVector . VP.fromList <$> arbitrary++withSeed :: forall a. SeedVector -> (forall s. MWC.Gen s -> ST s a) -> a+withSeed (SeedVector seed) f = runST $ MWC.initialize seed >>= f++withSeed2 ::+ forall a. (Eq a, Show a)+ => SeedVector+ -> (forall s. MWC.Gen s -> ST s a)+ -> (forall s. MWC.Gen s -> ST s a)+ -> Property+withSeed2 seed f g = withSeed @a seed f === withSeed seed g++withSeedV2 ::+ forall r e. (Eq e, Show e, Prim e, Load r Ix1 e)+ => SeedVector+ -> (forall s. MWC.Gen s -> ST s (V.Vector r e))+ -> (forall s. MWC.Gen s -> ST s (VP.Vector e))+ -> Property+withSeedV2 seed f g = withSeed @(V.Vector r e) seed f !==! withSeed seed g+++prop_sreplicateM :: SeedVector -> Int -> Property+prop_sreplicateM seed k = withSeedV2 @DS @Word seed+ (V.sreplicateM (Sz k) . uniform)+ (VP.replicateM k . uniform)++prop_sgenerateM :: SeedVector -> Int -> Fun Int Word -> Property+prop_sgenerateM seed k f = withSeedV2 @DS @Word seed+ (genWith (V.sgenerateM (Sz k)))+ (genWith (VP.generateM k))+ where+ genWith :: PrimMonad f => ((Int -> f Word) -> t) -> MWC.Gen (PrimState f) -> t+ genWith genM gen = genM (\i -> xor (apply f i) <$> uniform gen)+++prop_siterateNM :: SeedVector -> Int -> Word -> Property+prop_siterateNM seed k a =+ withSeed @(V.Vector DS Word) seed (genWith (\f -> V.siterateNM (Sz k) f a))+ !==! withSeed seed (genWith (\f -> VP.iterateNM k f a))+ where+ genWith :: PrimMonad f => ((Word -> f Word) -> t) -> MWC.Gen (PrimState f) -> t+ genWith genM gen = genM (\prev -> xor prev <$> uniform gen)+++genWithUnfoldrM ::+ PrimMonad f => ((Word -> f (Maybe (Word, Word))) -> t) -> MWC.Gen (PrimState f) -> t+genWithUnfoldrM genM gen = genM $ \prev -> do+ x <- uniform gen+ let cur = prev `xor` x+ pure $ if cur `mod` 17 == 0 then Nothing else Just (x, cur)++prop_sunfoldrM :: SeedVector -> Word -> Property+prop_sunfoldrM seed a =+ withSeedV2 @DS @Word seed+ (genWithUnfoldrM (`V.sunfoldrM` a))+ (genWithUnfoldrM (`VP.unfoldrM`a))++prop_sunfoldrNM :: SeedVector -> Int -> Word -> Property+prop_sunfoldrNM seed k a =+ withSeedV2 @DS @Word seed+ (genWithUnfoldrM (\f -> V.sunfoldrNM (Sz k) f a))+ (genWithUnfoldrM (\f -> VP.unfoldrNM k f a))+ .&&.+ withSeedV2 @DS @Word seed+ (genWithUnfoldrM (\f -> A.unsafeUnfoldrNM (Sz k) f a))+ (genWithUnfoldrM (\f -> VP.unfoldrNM k f a))++prop_sunfoldrExactNM :: SeedVector -> Int -> Word -> Property+prop_sunfoldrExactNM seed k a =+ withSeedV2 @DS @Word seed+ (genWith (\f -> V.sunfoldrExactNM (Sz k) f a))+ (genWith (\f -> VP.unfoldrNM k (fmap Just . f) a))+ where+ genWith :: PrimMonad f => ((Word -> f (Word, Word)) -> t) -> MWC.Gen (PrimState f) -> t+ genWith genM gen = genM $ \prev -> do+ x <- uniform gen+ pure (x, prev `xor` x)+++genWithMapM :: PrimMonad m => ((Word -> m Word) -> m a) -> MWC.Gen (PrimState m) -> m a+genWithMapM genM gen = genM $ \e -> xor e <$> uniform gen+genWithMapWS :: PrimMonad m => ((Word -> MWC.Gen (PrimState m) -> m Word) -> m a) -> m a+genWithMapWS genM = genM $ \e gen -> xor e <$> uniform gen++genWithIMapM :: PrimMonad m => ((Int -> Word -> m Word) -> m a) -> MWC.Gen (PrimState m) -> m a+genWithIMapM genM gen = genM $ \i e -> do+ ir <- uniformR (0, fromIntegral i) gen+ xor ir . xor e <$> uniform gen+genWithIMapWS :: PrimMonad m => ((Int -> Word -> MWC.Gen (PrimState m) -> m Word) -> m a) -> m a+genWithIMapWS genM =+ genM $ \i e gen -> do+ ir <- uniformR (0, fromIntegral i) gen+ xor ir . xor e <$> uniform gen+++genWithMapM_ :: PrimMonad m => ((Word -> m ()) -> m ()) -> MWC.Gen (PrimState m) -> m Word+genWithMapM_ genM gen = do+ ref <- newMutVar =<< uniform gen+ genM $ \e -> do+ e' <- xor e <$> uniform gen+ modifyMutVar ref (xor e')+ readMutVar ref++genWithIMapM_ :: PrimMonad m => ((Int -> Word -> m ()) -> m ()) -> MWC.Gen (PrimState m) -> m Word+genWithIMapM_ genM gen = do+ ref <- newMutVar =<< uniform gen+ genM $ \i e -> do+ ir <- uniformR (0, fromIntegral i) gen+ e' <- xor ir . xor e <$> uniform gen+ modifyMutVar ref (xor e')+ readMutVar ref++prop_straverse :: SeedVector -> Array P Ix2 Word -> Property+prop_straverse seed a =+ withSeed @(V.Vector DS Word) seed (genWithMapM (`V.straverse` a))+ !==! withSeed seed (genWithMapM (`VP.mapM` toPrimitiveVector a))++prop_smapM :: SeedVector -> Array P Ix2 Word -> Property+prop_smapM seed a =+ withSeed @(V.Vector DS Word) seed (genWithMapM (`V.smapM` a))+ !==! withSeed seed (genWithMapM (`VP.mapM` toPrimitiveVector a))++prop_smapMaybeM :: SeedVector -> Array B Ix2 Word -> Fun Word (Maybe Word16) -> Property+prop_smapMaybeM seed a gm =+ withSeed @(V.Vector DS Word16) seed (genWithMapM (\ f -> V.smapMaybeM (fmap g . f) a))+ !==! withSeed seed (genWithMapM+ (\f -> VP.convert . VB.mapMaybe id <$> VB.mapM (fmap g . f) (toBoxedVector a)))+ where g = apply gm++prop_sitraverse :: SeedVector -> Vector P Word -> Property+prop_sitraverse seed a =+ withSeed @(V.Vector DS Word) seed (genWithIMapM (`V.sitraverse` a))+ !==! withSeed seed (genWithIMapM (\f -> VP.convert <$> VU.mapM (uncurry f) vp))+ where+ vp = VU.imap (,) $ toUnboxedVector (compute a)++prop_simapM :: SeedVector -> Vector U Word -> Property+prop_simapM seed a =+ withSeed @(V.Vector DS Word) seed (genWithIMapM (V.siforM a))+ !==! withSeed seed (genWithIMapM (\f -> VP.convert <$> VU.mapM (uncurry f) vp))+ where+ vp = VU.imap (,) $ toUnboxedVector a++prop_smapM_ :: SeedVector -> Array P Ix2 Word -> Property+prop_smapM_ seed a =+ withSeed seed (genWithMapM_ (V.sforM_ a)) ===+ withSeed seed (genWithMapM_ (VP.forM_ (toPrimitiveVector a)))++prop_simapM_ :: SeedVector -> Vector U Word -> Property+prop_simapM_ seed a =+ withSeed seed (genWithIMapM_ (V.siforM_ a)) ===+ withSeed seed (genWithIMapM_ (\f -> VU.mapM_ (uncurry f) vp))+ where+ vp = VU.imap (,) $ toUnboxedVector a++prop_sfilterM :: SeedVector -> Fun Word Bool -> Vector P Word -> Property+prop_sfilterM seed g a =+ withSeed @(V.Vector DS Word) seed (genWith (`V.sfilterM` a))+ !==! withSeed seed (genWith (`VP.filterM` toPrimitiveVector a))+ where+ genWith :: PrimMonad f => ((Word -> f Bool) -> t) -> MWC.Gen (PrimState f) -> t+ genWith genM gen = genM $ \e -> do+ x <- xor e <$> uniform gen+ pure $ apply g x++prop_sifilterM :: SeedVector -> Fun Word Bool -> Vector U Word -> Property+prop_sifilterM seed g a =+ withSeed @(V.Vector DS Word) seed (genWith (`V.sifilterM` a))+ !==! withSeed seed (genWith (\f -> VP.convert . VU.map snd <$> VU.filterM (uncurry f) vp))+ where+ vp = VU.imap (,) $ toUnboxedVector a+ genWith :: PrimMonad f => ((Int -> Word -> f Bool) -> t) -> MWC.Gen (PrimState f) -> t+ genWith genM gen = genM $ \i e -> do+ ir <- uniformR (0, fromIntegral i) gen+ x <- xor ir . xor e <$> uniform gen+ pure $ apply g x++++applyFun4 :: Fun (a, b, c, d) e -> (a -> b -> c -> d -> e)+applyFun4 (Fun _ f) a b c d = f (a, b, c, d)+applyFun5 :: Fun (a, b, c, d, e) f -> (a -> b -> c -> d -> e -> f)+applyFun5 (Fun _ g) a b c d f = g (a, b, c, d, f)+applyFun6 :: Fun (a, (b, c, d, e, f)) g -> (a -> b -> c -> d -> e -> f -> g)+applyFun6 (Fun _ h) a b c d f g = h (a, (b, c, d, f, g))+applyFun7 :: Fun (a, b, (c, d, e, f, g)) h -> (a -> b -> c -> d -> e -> f -> g -> h)+applyFun7 (Fun _ i) a b c d f g h = i (a, b, (c, d, f, g, h))++com2M :: Fun (a, b) d -> (d -> c) -> a -> b -> c+com2M f g a = g . applyFun2 f a++com3M :: Fun (a, b, c) d -> (d -> e) -> a -> b -> c -> e+com3M f g a b = g . applyFun3 f a b++com4M :: Fun (a, b, c, d) e -> (e -> h) -> a -> b -> c -> d -> h+com4M f g a b c = g . applyFun4 f a b c++com5M :: Fun (a, b, c, d, e) h -> (h -> i) -> a -> b -> c -> d -> e -> i+com5M f g a b c d = g . applyFun5 f a b c d++com6M :: Fun (a, (b, c, d, e, h)) i -> (i -> j) -> a -> b -> c -> d -> e -> h -> j+com6M f g a b c d e = g . applyFun6 f a b c d e++com7M :: Fun (a, b, (c, d, e, h, i)) j -> (j -> k) -> a -> b -> c -> d -> e -> h -> i -> k+com7M f g a b c d e h = g . applyFun7 f a b c d e h+++prop_szip :: Vector U Word -> Vector U Int -> Property+prop_szip v1 v2 = compute (V.szip v1 v2) === toUnboxV2 VU.zip v1 v2++prop_szip3 :: Vector U Word64 -> Vector U Word32 -> Vector U Word16 -> Property+prop_szip3 v1 v2 v3 = compute (V.szip3 v1 v2 v3) === toUnboxV3 VU.zip3 v1 v2 v3++prop_szip4 :: Vector U Word64 -> Vector U Word32 -> Vector U Word16 -> Vector U Word8 -> Property+prop_szip4 v1 v2 v3 v4 = compute (V.szip4 v1 v2 v3 v4) === toUnboxV4 VU.zip4 v1 v2 v3 v4++prop_szip5 ::+ Vector U Word64+ -> Vector U Word32+ -> Vector U Word16+ -> Vector U Word8+ -> Vector U Int8+ -> Property+prop_szip5 v1 v2 v3 v4 v5 = compute (V.szip5 v1 v2 v3 v4 v5) === toUnboxV5 VU.zip5 v1 v2 v3 v4 v5++prop_szip6 ::+ Vector U Word64+ -> Vector U Word32+ -> Vector U Word16+ -> Vector U Word8+ -> Vector U Int8+ -> Vector U Int16+ -> Property+prop_szip6 v1 v2 v3 v4 v5 v6 =+ compute (V.szip6 v1 v2 v3 v4 v5 v6) === toUnboxV6 VU.zip6 v1 v2 v3 v4 v5 v6+++prop_szipWith :: Vector P Word -> Vector P Int -> Fun (Word, Int) Int -> Property+prop_szipWith v1 v2 f =+ V.szipWith (applyFun2 f) v1 v2 !==! toPrimV2 (VP.zipWith (applyFun2 f)) v1 v2++prop_szipWith3 ::+ Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Fun (Word64, Word32, Word16) Int+ -> Property+prop_szipWith3 v1 v2 v3 f =+ V.szipWith3 (applyFun3 f) v1 v2 v3 !==! toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3++prop_szipWith4 ::+ Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Fun (Word64, Word32, Word16, Word8) Int+ -> Property+prop_szipWith4 v1 v2 v3 v4 f =+ V.szipWith4 (applyFun4 f) v1 v2 v3 v4 !==! toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4++prop_szipWith5 ::+ Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Word64, Word32, Word16, Word8, Int8) Int+ -> Property+prop_szipWith5 v1 v2 v3 v4 v5 f =+ V.szipWith5 (applyFun5 f) v1 v2 v3 v4 v5 !==! toPrimV5 (VP.zipWith5 (applyFun5 f)) v1 v2 v3 v4 v5++prop_szipWith6 ::+ Vector DS Word64+ -> Vector B Word32+ -> Vector N Word16+ -> Vector S Word8+ -> Vector U Int8+ -> Vector P Int16+ -> Fun (Word64, (Word32, Word16, Word8, Int8, Int16)) Int+ -> Property+prop_szipWith6 v1 v2 v3 v4 v5 v6 f =+ V.szipWith6 (applyFun6 f) v1 v2 v3 v4 v5 v6 !==!+ toPrimV6+ (VP.zipWith6 (applyFun6 f))+ (compute v1)+ (compute v2)+ (compute v3)+ (compute v4)+ (compute v5)+ v6++prop_sizipWith :: Vector DS Word64 -> Vector DS Word32 -> Fun (Ix1, Word64, Word32) Int -> Property+prop_sizipWith v1 v2 f =+ sizipWith (applyFun3 f) v1 v2 !==!+ toPrimV2 (VP.izipWith (applyFun3 f)) (compute v1) (compute v2)++prop_sizipWith3 ::+ Vector P Word64+ -> Vector D Word32+ -> Vector D Word16+ -> Fun (Ix1, Word64, Word32, Word16) Int+ -> Property+prop_sizipWith3 v1 v2 v3 f =+ sizipWith3 (applyFun4 f) v1 v2 v3 !==!+ toPrimV3 (VP.izipWith3 (applyFun4 f)) (compute v1) (compute v2) (compute v3)++prop_sizipWith4 ::+ Vector D Word64+ -> Vector DS Word32+ -> Vector P Word16+ -> Vector U Word8+ -> Fun (Ix1, Word64, Word32, Word16, Word8) Int+ -> Property+prop_sizipWith4 v1 v2 v3 v4 f =+ sizipWith4 (applyFun5 f) v1 v2 v3 v4 !==!+ toPrimV4 (VP.izipWith4 (applyFun5 f)) (compute v1) (compute v2) (compute v3) (compute v4)++prop_sizipWith5 ::+ Vector DS Word64+ -> Vector S Word32+ -> Vector P Word16+ -> Vector U Word8+ -> Vector N Int8+ -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Int+ -> Property+prop_sizipWith5 v1 v2 v3 v4 v5 f =+ sizipWith5 (applyFun6 f) v1 v2 v3 v4 v5 !==!+ toPrimV5 (VP.izipWith5 (applyFun6 f)) (compute v1) (compute v2) v3 (compute v4) (compute v5)++prop_sizipWith6 ::+ Vector DS Word64+ -> Vector D Word32+ -> Vector B Word16+ -> Vector N Word8+ -> Vector P Int8+ -> Vector P Int16+ -> Fun (Ix1, Word64, (Word32, Word16, Word8, Int8, Int16)) Int+ -> Property+prop_sizipWith6 v1 v2 v3 v4 v5 v6 f =+ sizipWith6 (applyFun7 f) v1 v2 v3 v4 v5 v6 !==!+ toPrimV6 (VP.izipWith6 (applyFun7 f)) (compute v1) (compute v2) (compute v3) (compute v4) v5 v6+++prop_szipWithM ::+ SeedVector -> Vector P Word64 -> Vector P Word32 -> Fun (Word64, Word32) Word -> Property+prop_szipWithM seed v1 v2 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.szipWithM (com2M f g) v1 v2))+ (genWithMapM (\g -> toPrimV2 (VP.zipWithM (com2M f g)) v1 v2))++prop_szipWith3M ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Fun (Word64, Word32, Word16) Word+ -> Property+prop_szipWith3M seed v1 v2 v3 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.szipWith3M (com3M f g) v1 v2 v3))+ (genWithMapM (VP.forM (toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3)))++prop_szipWith4M ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Fun (Word64, Word32, Word16, Word8) Word+ -> Property+prop_szipWith4M seed v1 v2 v3 v4 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.szipWith4M (com4M f g) v1 v2 v3 v4))+ (genWithMapM (VP.forM (toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4)))+++prop_szipWith5M ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Word64, Word32, Word16, Word8, Int8) Word+ -> Property+prop_szipWith5M seed v1 v2 v3 v4 v5 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.szipWith5M (com5M f g) v1 v2 v3 v4 v5))+ (genWithMapM (VP.forM (toPrimV5 (VP.zipWith5 (applyFun5 f)) v1 v2 v3 v4 v5)))+++prop_szipWith6M ::+ SeedVector+ -> Vector P Int16+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Int16, (Word64, Word32, Word16, Word8, Int8)) Word+ -> Property+prop_szipWith6M seed v1 v2 v3 v4 v5 v6 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.szipWith6M (com6M f g) v1 v2 v3 v4 v5 v6))+ (genWithMapM (VP.forM (toPrimV6 (VP.zipWith6 (applyFun6 f)) v1 v2 v3 v4 v5 v6)))+++prop_szipWithM_ ::+ SeedVector -> Vector P Word64 -> Vector P Word32 -> Fun (Word64, Word32) Word -> Property+prop_szipWithM_ seed v1 v2 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.szipWithM_ (com2M f g) v1 v2))+ (genWithMapM_ (\g -> toPrimV2 (VP.zipWithM_ (com2M f g)) v1 v2))++prop_szipWith3M_ ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Fun (Word64, Word32, Word16) Word+ -> Property+prop_szipWith3M_ seed v1 v2 v3 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.szipWith3M_ (com3M f g) v1 v2 v3))+ (genWithMapM_ (VP.forM_ (toPrimV3 (VP.zipWith3 (applyFun3 f)) v1 v2 v3)))++prop_szipWith4M_ ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Fun (Word64, Word32, Word16, Word8) Word+ -> Property+prop_szipWith4M_ seed v1 v2 v3 v4 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.szipWith4M_ (com4M f g) v1 v2 v3 v4))+ (genWithMapM_ (VP.forM_ (toPrimV4 (VP.zipWith4 (applyFun4 f)) v1 v2 v3 v4)))+++prop_szipWith5M_ ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Word64, Word32, Word16, Word8, Int8) Word+ -> Property+prop_szipWith5M_ seed v1 v2 v3 v4 v5 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.szipWith5M_ (com5M f g) v1 v2 v3 v4 v5))+ (genWithMapM_ (VP.forM_ (toPrimV5 (VP.zipWith5 (applyFun5 f)) v1 v2 v3 v4 v5)))++prop_szipWith6M_ ::+ SeedVector+ -> Vector P Int16+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Int16, (Word64, Word32, Word16, Word8, Int8)) Word+ -> Property+prop_szipWith6M_ seed v1 v2 v3 v4 v5 v6 f =+ withSeed2 seed+ (genWithMapM_ (\g -> V.szipWith6M_ (com6M f g) v1 v2 v3 v4 v5 v6))+ (genWithMapM_ (VP.forM_ (toPrimV6 (VP.zipWith6 (applyFun6 f)) v1 v2 v3 v4 v5 v6)))++prop_sizipWithM ::+ SeedVector -> Vector U Word64 -> Vector U Word32 -> Fun (Ix1, Word64, Word32) Word -> Property+prop_sizipWithM seed v1 v2 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.sizipWithM (com3M f g) v1 v2))+ (genWithMapM (\g -> VP.convert <$>+ VU.izipWithM (com3M f g) (toUnboxedVector v1) (toUnboxedVector v2)))++prop_sizipWith3M ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Fun (Ix1, Word64, Word32, Word16) Word+ -> Property+prop_sizipWith3M seed v1 v2 v3 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.sizipWith3M (com4M f g) v1 v2 v3))+ (genWithMapM (VP.forM (toPrimV3 (VP.izipWith3 (applyFun4 f)) v1 v2 v3)))++prop_sizipWith4M ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Fun (Ix1, Word64, Word32, Word16, Word8) Word+ -> Property+prop_sizipWith4M seed v1 v2 v3 v4 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.sizipWith4M (com5M f g) v1 v2 v3 v4))+ (genWithMapM (VP.forM (toPrimV4 (VP.izipWith4 (applyFun5 f)) v1 v2 v3 v4)))++prop_sizipWith5M ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Word+ -> Property+prop_sizipWith5M seed v1 v2 v3 v4 v5 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.sizipWith5M (com6M f g) v1 v2 v3 v4 v5))+ (genWithMapM (VP.forM (toPrimV5 (VP.izipWith5 (applyFun6 f)) v1 v2 v3 v4 v5)))+++prop_sizipWith6M ::+ SeedVector+ -> Vector P Int16+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Ix1, Int16, (Word64, Word32, Word16, Word8, Int8)) Word+ -> Property+prop_sizipWith6M seed v1 v2 v3 v4 v5 v6 f =+ withSeedV2 @DS @Word seed+ (genWithMapM (\g -> V.sizipWith6M (com7M f g) v1 v2 v3 v4 v5 v6))+ (genWithMapM (VP.forM (toPrimV6 (VP.izipWith6 (applyFun7 f)) v1 v2 v3 v4 v5 v6)))+++prop_sizipWithM_ ::+ SeedVector -> Vector U Word64 -> Vector U Word32 -> Fun (Ix1, Word64, Word32) Word -> Property+prop_sizipWithM_ seed v1 v2 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.sizipWithM_ (com3M f g) v1 v2))+ (genWithMapM_ (\g -> VU.izipWithM_ (com3M f g) (toUnboxedVector v1) (toUnboxedVector v2)))++prop_sizipWith3M_ ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Fun (Ix1, Word64, Word32, Word16) Word+ -> Property+prop_sizipWith3M_ seed v1 v2 v3 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.sizipWith3M_ (com4M f g) v1 v2 v3))+ (genWithMapM_ (VP.forM_ (toPrimV3 (VP.izipWith3 (applyFun4 f)) v1 v2 v3)))++prop_sizipWith4M_ ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Fun (Ix1, Word64, Word32, Word16, Word8) Word+ -> Property+prop_sizipWith4M_ seed v1 v2 v3 v4 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.sizipWith4M_ (com5M f g) v1 v2 v3 v4))+ (genWithMapM_ (VP.forM_ (toPrimV4 (VP.izipWith4 (applyFun5 f)) v1 v2 v3 v4)))+++prop_sizipWith5M_ ::+ SeedVector+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Word+ -> Property+prop_sizipWith5M_ seed v1 v2 v3 v4 v5 f =+ withSeed2+ seed+ (genWithMapM_ (\g -> V.sizipWith5M_ (com6M f g) v1 v2 v3 v4 v5))+ (genWithMapM_ (VP.forM_ (toPrimV5 (VP.izipWith5 (applyFun6 f)) v1 v2 v3 v4 v5)))+++prop_sizipWith6M_ ::+ SeedVector+ -> Vector P Int16+ -> Vector P Word64+ -> Vector P Word32+ -> Vector P Word16+ -> Vector P Word8+ -> Vector P Int8+ -> Fun (Ix1, Int16, (Word64, Word32, Word16, Word8, Int8)) Word+ -> Property+prop_sizipWith6M_ seed v1 v2 v3 v4 v5 v6 f =+ withSeed2 seed+ (genWithMapM_ (\g -> V.sizipWith6M_ (com7M f g) v1 v2 v3 v4 v5 v6))+ (genWithMapM_ (VP.forM_ (toPrimV6 (VP.izipWith6 (applyFun7 f)) v1 v2 v3 v4 v5 v6)))++spec :: Spec+spec =+ describe "Vector" $ do+ describe "same-as-array" $ do+ describe "traverse" $ do+ prop "straverse == traversePrim" prop_straverse_traversePrim+ prop "sitraverse == itraversePrim" prop_sitraverse_itraversePrim+ prop "sitraverse == itraverseA" prop_sitraverse_itraverseA+ prop "simapM_ == itraverseA_" prop_simapM_itraverseA_+ prop "smapM_ == traverseA_" prop_smapM_traverseA_+ prop "sforM == forM" prop_sforM_forM+ prop "siforM == iforM" prop_siforM_iforM+ prop "sforM_ == forM_" prop_sforM_forM_+ prop "siforM_ == iforM_" prop_siforM_iforM_+ prop "sforM_ == forIO_ (ParN 1)" prop_sforM_forIO_+ prop "sforM == forIO (Seq)" prop_sforM_forIO+ prop "siforM == iforIO (ParN 1)" prop_siforM_iforIO+ prop "siforM == iforIO_ (ParN 1)" prop_siforM_iforIO_+ prop "siforM == iforWS (ParN 1)" prop_siforM_iforWS+ prop "smapM == mapWS (Seq)" prop_smapM_mapWS+ describe "Enumeration" $ do+ prop "senumFromN" $ \comp (i :: Int) sz ->+ computeAs S (V.senumFromN i sz) === compute (A.enumFromN comp i sz)+ prop "senumFromStepN" $ \comp (i :: Int) s sz ->+ computeAs S (V.senumFromStepN i s sz) === compute (A.enumFromStepN comp i s sz)+ describe "same-as-vector-package" $ do+ describe "Accessors" $ do+ describe "Size" $ do+ it "slength" $ do+ slength (sfromList []) `shouldBe` Nothing+ slength (sfromListN 1 []) `shouldBe` Nothing+ slength (sgenerate 1 id) `shouldBe` Just 1+ it "snull" $ do+ snull sempty `shouldBe` True+ snull (fromLists' Seq [[]] :: Array P Ix2 Int) `shouldBe` True+ snull (siterateN 3 id ()) `shouldBe` False+ snull (0 ..: 1 :> 2 :> 3 :. 0) `shouldBe` True+ describe "Indexing" $ do+ prop "head' (non-empty)" $ \(ArrNE arr :: ArrNE D Ix1 Int) ->+ head' arr === evaluate' arr 0 .&&. head' arr === shead' arr+ prop "head'" $ \(arr :: Array D Ix1 Int) ->+ (singleton (head' arr) :: Array D Ix1 Int) !!==!!+ VP.singleton (VP.head (toPrimitiveVector (compute arr)))+ prop "shead'" $ \(arr :: Array P Ix1 Int) ->+ (singleton (shead' arr) :: Array D Ix1 Int) !!==!!+ VP.singleton (VP.head (toPrimitiveVector arr))+ prop "last'" $ \(arr :: Array P Ix1 Int) ->+ (singleton (last' arr) :: Array D Ix1 Int) !!==!!+ VP.singleton (VP.last (toPrimitiveVector arr))+ prop "unconsM" $ \(v :: Vector D Int) ->+ fmap (computeAs P <$>) (A.unconsM v :: Maybe (Int, Vector D Int)) ===+ fmap (fmap (A.fromList Seq)) (List.uncons (A.toList v))+ prop "unsnocM" $ \(v :: Vector D Int) ->+ fmap (first (computeAs P)) (A.unsnocM v :: Maybe (Vector D Int, Int)) ===+ fmap+ (Tuple.swap . fmap (A.fromList Seq . List.reverse))+ (List.uncons (A.toList (A.reverse Dim1 v)))+ describe "Slicing" $ do+ prop "slice" $ \i sz (arr :: Array P Ix1 Word) ->+ V.slice i sz arr !!==!! VP.take (unSz sz) (VP.drop i (toPrimitiveVector arr))+ prop "sslice" $ \i sz (arr :: Array P Ix1 Word) ->+ computeAs B (V.sslice i sz arr) !!==!!+ VP.take (unSz sz) (VP.drop i (toPrimitiveVector arr))+ prop "slice'" $ \i sz (arr :: Array P Ix1 Word) ->+ V.slice' i sz arr !!==!! VP.slice i (unSz sz) (toPrimitiveVector arr)+ prop "init" $ \(arr :: Array P Ix1 Word) ->+ V.init arr !==! VP.reverse (VP.drop 1 (VP.reverse (toPrimitiveVector arr)))+ prop "init'" $ \(arr :: Array P Ix1 Word) ->+ V.init' arr !!==!! VP.init (toPrimitiveVector arr)+ prop "tail" $ \(arr :: Array P Ix1 Word) ->+ let vp = toPrimitiveVector arr+ in (V.tail arr !==! VP.drop 1 vp) .&&.+ (not (isEmpty arr) ==> V.tail arr !==! VP.tail vp)+ prop "tail'" $ \(arr :: Array P Ix1 Word) ->+ V.tail' arr !!==!! VP.tail (toPrimitiveVector arr)+ prop "take" $ \n (arr :: Array P Ix1 Word) ->+ V.take (Sz n) arr !==! VP.take n (toPrimitiveVector arr)+ prop "take'" $ \sz@(Sz n) (arr :: Array P Ix1 Word) ->+ V.take' sz arr !!==!! VP.slice 0 n (toPrimitiveVector arr)+ prop "stake" $ \n (arr :: Array P Ix1 Word) ->+ V.stake (Sz n) arr !==! VP.take n (toPrimitiveVector arr)+ prop "drop" $ \n (arr :: Array P Ix1 Word) ->+ V.drop (Sz n) arr !==! VP.drop n (toPrimitiveVector arr)+ prop "drop'" $ \sz@(Sz n) (arr :: Array P Ix1 Word) ->+ V.drop' sz arr !!==!! VP.slice n (unSz (size arr) - n) (toPrimitiveVector arr)+ prop "sdrop" $ \n (arr :: Array P Ix1 Word) ->+ V.sdrop (Sz n) arr !==! VP.drop n (toPrimitiveVector arr)+ prop "sliceAt" $ \sz (arr :: Array P Ix1 Word) ->+ let (larr, rarr) = V.sliceAt (Sz sz) arr+ (lvec, rvec) = VP.splitAt sz (toPrimitiveVector arr)+ in (larr !==! lvec) .&&. (rarr !==! rvec)+ prop "sliceAt'" $ \sz@(Sz n) (arr :: Array P Ix1 Word) ->+ let (larr, rarr) = V.sliceAt' sz arr+ lvec = VP.slice 0 n (toPrimitiveVector arr)+ rvec = VP.slice n (unSz (size arr) - n) (toPrimitiveVector arr)+ in (larr !!==!! lvec) .&&. (rarr !!==!! rvec)+ describe "Constructors" $ do+ describe "Initialization" $ do+ it "empty" $ toPrimitiveVector (V.empty :: V.Vector P Word) `shouldBe` VP.empty+ it "sempty" $+ toPrimitiveVector (compute (V.sempty :: V.Vector DS Word)) `shouldBe` VP.empty+ prop "singleton" $ \e -> (V.singleton e :: V.Vector P Word) !==! VP.singleton e+ prop "ssingleton" $ \(e :: Word) -> V.ssingleton e !==! VP.singleton e+ prop "replicate" $ \comp k (e :: Word) -> V.replicate comp (Sz k) e !==! VP.replicate k e+ prop "sreplicate" $ \k (e :: Word) -> V.sreplicate (Sz k) e !==! VP.replicate k e+ prop "generate" $ \comp k (f :: Fun Int Word) ->+ V.generate comp (Sz k) (apply f) !==! VP.generate k (apply f)+ prop "sgenerate" $ \k (f :: Fun Int Word) ->+ V.sgenerate (Sz k) (apply f) !==! VP.generate k (apply f)+ prop "siterateN" $ \n (f :: Fun Word Word) a ->+ V.siterateN (Sz n) (apply f) a !==! VP.iterateN n (apply f) a+ prop "siterate" $ \n (f :: Fun Word Word) a ->+ computeAs P (V.stake n (V.siterate (apply f) a)) ===+ computeAs P (V.siterateN n (apply f) a)+ prop "cons" $ \e (v :: Vector P Word) ->+ computeAs P (V.cons e (toLoadArray v)) !!==!! VP.cons e (toPrimitiveVector v)+ describe "Monadic initialization" $ do+ prop "sreplicateM" prop_sreplicateM+ prop "sgenerateM" prop_sgenerateM+ prop "siterateNM" prop_siterateNM+ describe "Unfolding" $ do+ prop "sunfoldr" $ \(a :: Word) ->+ let f b+ | b > 10000 || b `div` 17 == 0 = Nothing+ | otherwise = Just (b * b, b + 1)+ in V.sunfoldr f a !==! VP.unfoldr f a+ prop "sunfoldrN" $ \n (a :: Word) ->+ let f b+ | b > 10000 || b `div` 19 == 0 = Nothing+ | otherwise = Just (b * b, b + 1)+ in V.sunfoldrN (Sz n) f a !==! VP.unfoldrN n f a .&&. A.unsafeUnfoldrN (Sz n) f a !==!+ VP.unfoldrN n f a+ it "sunfoldrN (maxBound)" $+ let maxv = V.sunfoldrN (Sz maxBound) (const (Nothing :: Maybe (Word8, Word8))) 0+ in computeAs P maxv `shouldBe` A.empty+ prop "sunfoldrExactN" $ \n (a :: Word) ->+ let f b = (b * b, b + 1)+ in V.sunfoldrExactN (Sz n) f a !==! VP.unfoldrN n (Just . f) a+ prop "sunfoldrM" prop_sunfoldrM+ prop "sunfoldrNM" prop_sunfoldrNM+ it "sunfoldrNM (maxBound)" $+ let maxv = V.sunfoldrNM (Sz maxBound) (pure . const (Nothing :: Maybe (Word8, Word8))) 0+ in computeAs P <$> maxv `shouldReturn` A.empty+ prop "sunfoldrExactM" prop_sunfoldrExactNM+ describe "Enumeration" $ do+ prop "senumFromN" $ \(i :: Int) n -> V.senumFromN i (Sz n) !==! VP.enumFromN i n+ prop "senumFromStepN" $ \(i :: Int) s n ->+ V.senumFromStepN i s (Sz n) !==! VP.enumFromStepN i s n+ describe "Concatenation" $ do+ prop "sappend" $ \(v1 :: Vector D Int) (v2 :: Vector P Int) ->+ V.sappend v1 v2 !==! toPrimitiveVector (compute v1) VP.++ toPrimitiveVector v2+ prop "sconcat" $ \(vs :: [Vector P Int]) ->+ V.sconcat vs !==! VP.concat (fmap toPrimitiveVector vs)+ describe "Predicates" $ do+ describe "Filtering" $ do+ prop "sfilter" $ \(v :: Vector P Word) (f :: Fun Word Bool) ->+ V.sfilter (apply f) v !==! VP.filter (apply f) (toPrimitiveVector v)+ prop "sifilter" $ \(v :: Vector P Word) (f :: Fun (Int, Word) Bool) ->+ V.sifilter (applyFun2 f) v !==! VP.ifilter (applyFun2 f) (toPrimitiveVector v)+ prop "sfilterM" prop_sfilterM+ prop "sifilterM" prop_sifilterM+ prop "smapMaybe" $ \(v :: Vector P Word) (f :: Fun Word (Maybe Int)) ->+ V.smapMaybe (apply f) v !==! VP.mapMaybe (apply f) (toPrimitiveVector v)+ prop "simapMaybe" $ \(v :: Vector P Word) (f :: Fun (Int, Word) (Maybe Int)) ->+ V.simapMaybe (applyFun2 f) v !==! VP.imapMaybe (applyFun2 f) (toPrimitiveVector v)+ prop "scatMaybes" $ \(v :: Vector D (Maybe Word)) ->+ V.scatMaybes v !==! toPrimitiveVector (compute (smap fromJust (sfilter isJust v)))+ prop "smapMaybeM" prop_smapMaybeM+ describe "Mapping" $ do+ prop "fmap" $ \(v :: Vector DS Word) (f :: Fun Word Int) ->+ fmap (apply f) v !==! VP.map (apply f) (toPrimitiveVector (compute v))+ prop "<$" $ \(v :: Vector DS Word) (a :: Char) ->+ (a <$ v) !==! VP.replicate (totalElem (size v)) a+ prop "smap" $ \(v :: Vector P Word) (f :: Fun Word Int) ->+ V.smap (apply f) v !==! VP.map (apply f) (toPrimitiveVector v)+ prop "simap" $ \(v :: Vector P Word) (f :: Fun (Int, Word) Int) ->+ V.simap (applyFun2 f) v !==! VP.imap (applyFun2 f) (toPrimitiveVector v)+ prop "straverse" prop_straverse+ prop "sitraverse" prop_sitraverse+ prop "smapM" prop_smapM+ prop "simapM" prop_simapM+ prop "smapM" prop_smapM_+ prop "simapM" prop_simapM_+ prop "szip" prop_szip+ prop "szip3" prop_szip3+ prop "szip4" prop_szip4+ prop "szip5" prop_szip5+ prop "szip6" prop_szip6+ prop "szipWith" prop_szipWith+ prop "szipWith3" prop_szipWith3+ prop "szipWith4" prop_szipWith4+ prop "szipWith5" prop_szipWith5+ prop "szipWith6" prop_szipWith6+ prop "sizipWith" prop_sizipWith+ prop "sizipWith3" prop_sizipWith3+ prop "sizipWith4" prop_sizipWith4+ prop "sizipWith5" prop_sizipWith5+ prop "sizipWith6" prop_sizipWith6+ prop "liftA2" $ \(v1 :: Vector DS Word) (v2 :: Vector DS Int) (f :: Fun (Word, Int) Int) ->+ liftA2 (applyFun2 f) v1 v2 !==!+ toPrimV2 (VP.zipWith (applyFun2 f)) (compute v1) (compute v2)+ prop "szipWithM" prop_szipWithM+ prop "szipWith3M" prop_szipWith3M+ prop "szipWith4M" prop_szipWith4M+ prop "szipWith5M" prop_szipWith5M+ prop "szipWith6M" prop_szipWith6M+ prop "sizipWithM" prop_sizipWithM+ prop "sizipWith3M" prop_sizipWith3M+ prop "sizipWith4M" prop_sizipWith4M+ prop "sizipWith5M" prop_sizipWith5M+ prop "sizipWith6M" prop_sizipWith6M+ prop "szipWithM_" prop_szipWithM_+ prop "szipWith3M_" prop_szipWith3M_+ prop "szipWith4M_" prop_szipWith4M_+ prop "szipWith5M_" prop_szipWith5M_+ prop "szipWith6M_" prop_szipWith6M_+ prop "sizipWithM_" prop_sizipWithM_+ prop "sizipWith3M_" prop_sizipWith3M_+ prop "sizipWith4M_" prop_sizipWith4M_+ prop "sizipWith5M_" prop_sizipWith5M_+ prop "sizipWith6M_" prop_sizipWith6M_+ describe "Folding" $ do+ prop "sfoldl" $ \(v :: Vector P Word32) (f :: Fun (Word, Word32) Word) a0 ->+ V.sfoldl (applyFun2 f) a0 v === VP.foldl (applyFun2 f) a0 (toPrimitiveVector v)+ prop "sifoldl" $ \(v :: Vector P Word32) (f :: Fun (Word, Ix1, Word32) Word) a0 ->+ V.sifoldl (applyFun3 f) a0 v === VP.ifoldl (applyFun3 f) a0 (toPrimitiveVector v)+ prop "sfoldl1'" prop_sfoldl1'+ describe "Specialized" $ do+ prop "sor" $ \(v :: Vector S Bool) -> V.sor v === VS.or (toStorableVector v)+ prop "sand" $ \(v :: Vector S Bool) -> V.sand v === VS.and (toStorableVector v)+ prop "sany" $ \(v :: Vector P Word) (f :: Fun Word Bool) ->+ V.sany (apply f) v === VP.any (apply f) (toPrimitiveVector v)+ prop "sall" $ \(v :: Vector P Word) (f :: Fun Word Bool) ->+ V.sall (apply f) v === VP.all (apply f) (toPrimitiveVector v)+ prop "ssum" $ \(v :: Vector P Word) -> V.ssum v === VP.sum (toPrimitiveVector v)+ prop "sproduct" $ \(v :: Vector P Word) ->+ V.sproduct v === VP.product (toPrimitiveVector v)+ prop "maximum'" prop_maximum'+ prop "minimum'" prop_minimum'+ prop "maximumM" prop_maximumM+ prop "minimumM" prop_minimumM+ describe "Conversion" $+ describe "Lists" $ do+ prop "sfromList" $ \comp (xs :: [Word]) ->+ sfromList xs !==! toPrimitiveVector (fromList comp xs)+ prop "sfromList" $ \(xs :: [Word]) -> sfromList xs !==! VP.fromList xs+ prop "sfromListN" $ \sz@(Sz n) (xs :: [Word]) -> sfromListN sz xs !==! VP.fromListN n xs+ prop "sfromListN (maxBound)" $ \(xs :: [Word]) ->+ sfromListN (Sz (maxBound `div` 8)) xs !==! VP.fromList xs+ prop "unsafeFromListN" $ \sz@(Sz n) (xs :: [Word]) ->+ A.unsafeFromListN sz xs !==! VP.fromListN n xs++prop_sfoldl1' :: Vector P Word -> Fun (Word, Word) Word -> Property+prop_sfoldl1' v f =+ V.singleton @D (V.sfoldl1' (applyFun2 f) v) !!==!!+ VP.singleton (VP.foldl1' (applyFun2 f) (toPrimitiveVector v))++prop_maximum' :: Vector P Word -> Property+prop_maximum' v =+ V.singleton @D (V.smaximum' v) !!==!! VP.singleton (VP.maximum (toPrimitiveVector v))++prop_minimum' :: Vector P Word -> Property+prop_minimum' v =+ V.singleton @D (V.sminimum' v) !!==!! VP.singleton (VP.minimum (toPrimitiveVector v))++prop_maximumM :: Vector P Word -> Property+prop_maximumM v =+ let vp = toPrimitiveVector v+ in V.smaximumM v === (guard (not (VP.null vp)) >> Just (VP.maximum vp))++prop_minimumM :: Vector P Word -> Property+prop_minimumM v =+ let vp = toPrimitiveVector v+ in V.sminimumM v === (guard (not (VP.null vp)) >> Just (VP.minimum vp))++prop_sitraverse_itraverseA :: SeedVector -> Vector S Word -> Property+prop_sitraverse_itraverseA seed a =+ withSeed2 @(V.Vector P Word) seed+ (fmap compute . genWithIMapM (`V.sitraverse` a))+ (genWithIMapM (`itraverseA` a))++prop_straverse_traversePrim :: SeedVector -> Vector S Word -> Property+prop_straverse_traversePrim seed a =+ withSeed2 @(V.Vector P Word) seed+ (fmap compute . genWithIMapM (\f -> V.straverse (f 0) a))+ (genWithIMapM (\f -> traversePrim (f 0) a))++prop_sitraverse_itraversePrim :: SeedVector -> Array P Ix3 Word -> Property+prop_sitraverse_itraversePrim seed a =+ withSeed2 @(V.Vector P Word) seed+ (genWithIMapM (\f -> compute <$> V.sitraverse (xorToLinear f) a))+ (genWithIMapM (\f -> flatten <$> itraversePrim @P (xorToLinear f) a))+ where+ xorToLinear f i = f (foldlIndex xor 0 i)++prop_smapM_traverseA_ :: SeedVector -> Array P Ix2 Word -> Property+prop_smapM_traverseA_ seed a =+ withSeed seed (genWithMapM_ (`V.smapM_` a)) === withSeed seed (genWithMapM_ (`traverseA_` a))++prop_simapM_itraverseA_ :: SeedVector -> Array P Ix2 Word -> Property+prop_simapM_itraverseA_ seed a =+ withSeed2+ seed+ (genWithIMapM_ (\f -> V.simapM_ (xorToLinear f) a))+ (genWithIMapM_ (\f -> itraverseA_ (xorToLinear f) a))+ where+ xorToLinear f i = f (foldlIndex xor 0 i)++prop_sforM_forM :: SeedVector -> Vector S Word -> Property+prop_sforM_forM seed a =+ withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (V.sforM a))+ === withSeed seed (genWithMapM (A.forM a))++prop_siforM_iforM :: SeedVector -> Vector S Word -> Property+prop_siforM_iforM seed a =+ withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a))+ === withSeed seed (genWithIMapM (iforM a))++withSeedIO :: forall a. SeedVector -> (MWC.Gen (PrimState IO) -> IO a) -> IO a+withSeedIO (SeedVector seed) f = MWC.initialize seed >>= f++prop_sforM_forIO :: SeedVector -> Vector S Word -> Property+prop_sforM_forIO seed a = property $+ withSeedIO seed (genWithMapM (forIO (setComp Seq a))) `shouldReturn`+ withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (V.sforM a))++prop_siforM_iforIO :: SeedVector -> Vector S Word -> Property+prop_siforM_iforIO seed a = property $+ withSeedIO seed (genWithIMapM (iforIO (setComp (ParN 1) a))) `shouldReturn`+ withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a))++prop_sforM_forM_ :: SeedVector -> Vector S Word -> Property+prop_sforM_forM_ seed a = property $+ withSeed seed (genWithMapM_ (A.forM_ a)) `shouldBe`+ withSeed @Word seed (genWithMapM_ (V.sforM_ a))++prop_siforM_iforM_ :: SeedVector -> Vector S Word -> Property+prop_siforM_iforM_ seed a = property $+ withSeed seed (genWithIMapM_ (iforM_ a)) `shouldBe`+ withSeed @Word seed (genWithIMapM_ (V.siforM_ a))++prop_sforM_forIO_ :: SeedVector -> Vector S Word -> Property+prop_sforM_forIO_ seed a = property $+ withSeedIO seed (genWithMapM_ (forIO_ (setComp (ParN 1) a))) `shouldReturn`+ withSeed @Word seed (genWithMapM_ (V.sforM_ a))++prop_siforM_iforIO_ :: SeedVector -> Vector S Word -> Property+prop_siforM_iforIO_ seed a = property $+ withSeedIO seed (genWithIMapM_ (iforIO_ (setComp (ParN 1) a))) `shouldReturn`+ withSeed @Word seed (genWithIMapM_ (V.siforM_ a))+++prop_siforM_iforWS :: SeedVector -> Vector S Word -> Property+prop_siforM_iforWS seed@(SeedVector sv) a =+ property $ do+ wsArray <-+ do ws <- initWorkerStates (ParN 1) (const (MWC.initialize sv))+ genWithIMapWS (iforWS ws a)+ wsArray `shouldBe` withSeed @(V.Vector P Word) seed (fmap compute . genWithIMapM (V.siforM a))++prop_smapM_mapWS :: SeedVector -> Vector S Word -> Property+prop_smapM_mapWS seed@(SeedVector sv) a =+ property $ do+ wsArray <-+ do ws <- initWorkerStates Seq (const (MWC.initialize sv))+ genWithMapWS (\f -> mapWS ws f a)+ wsArray `shouldBe` withSeed @(V.Vector P Word) seed (fmap compute . genWithMapM (`V.smapM` a))