8000 Added test for withMatAsVec · LumiGuide/haskell-opencv@b02385f · GitHub
[go: up one dir, main page]
Skip to content

Commit b02385f

Browse files
author
Nick Van den Broeck
committed
Added test for withMatAsVec
1 parent 2f1cb16 commit b02385f

File tree

2 files changed

+50
-0
lines changed

2 files changed

+50
-0
lines changed

‎opencv/opencv.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -276,10 +276,12 @@ test-suite test-opencv
276276
build-depends:
277277
base >= 4.8 && < 5
278278
, bytestring >= 0.10.6
279+
, exceptions
279280
, lens >= 4.13
280281
, linear >= 1.20.4
281282
, opencv
282283
, QuickCheck >= 2.8.2
284+
, random
283285
, repa >= 3.4.0.2
284286
, tasty >= 0.11.0.2
285287
, tasty-hunit >= 0.9.2

‎opencv/test/test.hs

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,15 @@
1+
{-# language AllowAmbiguousTypes #-}
12
{-# language FlexibleInstances #-}
23
{-# language TypeSynonymInstances #-}
34
{-# language TypeFamilies #-}
5+
{-# language TypeApplications #-}
46
{-# language CPP #-}
57
{-# options_ghc -fno-warn-orphans #-}
68

79
module Main where
810

911
import "base" Control.Exception ( evaluate, displayException )
12+
import "base" Control.Monad
1013
import "base" Data.Functor ( ($>) )
1114
import "base" Data.Int
1215
import "base" Data.Monoid
@@ -17,6 +20,7 @@ import "base" Data.Foldable ( for_, toList )
1720
import "base" Foreign.C.Types ( CFloat(..), CDouble(..) )
1821
import "base" Foreign.Storable ( Storable )
1922
import qualified "bytestring" Data.ByteString as B
23+
import "exceptions" Control.Monad.Catch
2024
import "lens" Control.Lens.Combinators ( view )
2125
import "linear" Linear.Matrix ( M23, M33, (!*) )
2226
import qualified "linear" Linear as L ( Metric(..) )
@@ -29,6 +33,7 @@ import "opencv" OpenCV.Unsafe
2933
import "opencv" OpenCV.Internal.Core.Types.Mat ( deallocateMatM )
3034
import "opencv" OpenCV.Internal.Exception ()
3135
import "opencv" OpenCV.Internal.Core.Types.Mat.Marshal ( marshalDepth, unmarshalDepth )
36+
import "random" System.Random (Random)
3237
import qualified "repa" Data.Array.Repa as Repa
3338
import "repa" Data.Array.Repa.Index ((:.)((:.)))
3439
import "tasty" Test.Tasty
@@ -111,6 +116,7 @@ main = defaultMain $ testGroup "opencv"
111116
[ HU.testCase "eye_m33 Word8" $ testWithMatAsVec (eye_m33 :: M33 Word8)
112117
, HU.testCase "eye_m33 Double" $ testWithMatAsVec (eye_m33 :: M33 Double)
113118
, HU.testCase "1..9 Int16" $ testWithMatAsVec (V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9) :: M33 Int16)
119+
, QC.testProperty "gives a storable vector with row major order" $ propWithMatAsVecOrder (Proxy @Int32)
114120
]
115121
]
116122
]
@@ -477,6 +483,48 @@ relError x y
477483
isSmall :: CFloat -> Bool
478484
isSmall = (>) 2e-2 . abs
479485

486+
genSplitNonZero :: (QC.Arbitrary a, Random a, Ord a, Num a)
487+
=> a -> QC.Gen (a, a)
488+
genSplitNonZero n
489+
| n <= 2 = pure (1, 1)
490+
| otherwise = do
491+
i <- QC.choose (1, n - 1)
492+
pure (i, n - i)
493+
494+
genSplit3NonZero :: (QC.Arbitrary a, Random a, Ord a, Num a)
495+
=> a -> QC.Gen (a, a, a)
496+
genSplit3NonZero n
497+
| n <= 3 = pure (1, 1, 1)
498+
| otherwise = do
499+
(a, z) <- genSplitNonZero n
500+
(b, c) <- genSplitNonZero z
501+
pure (a, b, c)
502+
503+
genDimensions :: QC.Gen (Int32, Int32, Int32)
504+
genDimensions = QC.sized $ \n -> genSplit3NonZero (fromIntegral n)
505+
506+
genArray :: (QC.Arbitrary a, Integral n) => (n, n, n) -> QC.Gen [[[a]]]
507+
genArray (a, b, c) = rep a $ rep b $ rep c QC.arbitrary
508+
where
509+
rep x = replicateM $ fromIntegral x
510+
511+
propWithMatAsVecOrder :: forall proxy a.
512+
(Eq a, Show a, Storable a, QC.Arbitrary a, ToDepth (proxy a))
513+
=> proxy a -> QC.Property
514+
propWithMatAsVecOrder proxy =
515+
--QC.forAll (QC.resize 10 genDimensions) $ \shape@(xDim, yDim, nOfChan) -> do
516+
QC.forAll genDimensions $ \shape@(xDim, yDim, nOfChan) -> do
517+
QC.forAll (genArray shape) $ \xs -> QC.ioProperty $
518+
case runExcept $ matFromFunc [xDim, yDim] nOfChan proxy $ ixToValue xs of
519+
Left err -> throwM err
520+
Right mat -> do
521+
let vect = VS.fromList . concat $ concat xs :: VS.Vector a
522+
vect' <- withMatAsVec mat $ \vs -> VS.freeze =<< VS.unsafeThaw vs
523+
pure $ vect' QC.=== vect
524+
where
525+
ixToValue ys [x, y] c = ys !! x !! y !! c
526+
ixToValue _ _ _ = error "ixToValue was called on a non-2D shape."
527+
480528
--------------------------------------------------------------------------------
481529

482530
eye23_8u_1c :: Mat (ShapeT [2, 3]) ('S 1) ('S Word8)

0 commit comments

Comments
 (0)
0