friday 0.2.1.1 → 0.2.1.2
raw patch · 3 files changed
+239/−1 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- friday.cabal +3/−1
- test/Test/Vision/Histogram.hs +114/−0
- test/Test/Vision/Image.hs +122/−0
friday.cabal view
@@ -2,7 +2,7 @@ -- +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.2.1.1+version: 0.2.1.2 synopsis: A functional image processing library for Haskell. homepage: https://github.com/RaphaelJ/friday license: LGPL-3@@ -86,6 +86,8 @@ type: exitcode-stdio-1.0 main-is: Test.hs+ other-modules: Test.Vision.Histogram+ Test.Vision.Image ghc-options: -Wall -O2 -rtsopts hs-source-dirs: test/ default-language: Haskell2010
+ test/Test/Vision/Histogram.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE BangPatterns+ , CPP+ , FlexibleContexts+ , FlexibleInstances+ , UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.Vision.Histogram (tests) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif++import Data.Int+import qualified Data.Vector.Storable as V+import Test.Framework (Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Arbitrary (..), Positive, getPositive)++import Vision.Histogram+import Vision.Image (Grey)+import qualified Vision.Image as I+import Vision.Primitive (Z (..), (:.) (..), DIM1, ix1, ix3)+import Test.Vision.Image ()++instance (Arbitrary (Positive p), Bounded p, Integral p, V.Storable p)+ => Arbitrary (Histogram DIM1 p) where+ arbitrary = do+ let !maxVal = maxBound `quot` 256 -- Sum musn't overflow.+ vec <- V.replicateM 256 (getPositive <$> arbitrary)+ return $ Histogram (Z :. 256) $ V.map (`rem` maxVal) vec++tests :: [Test]+tests = [+ testProperty "Sum of bins equals the number of pixels" propCalcHist++ , testProperty "The reduction of a 2D histogram gives the linear one."+ propReduceHist++ , testProperty "Resizing an histogram equals computing the smallest one."+ propResizeHist++ , testProperty "Cumulative histogram last bin equals original's sum"+ propCumulatHist++ , testProperty "Sum of an normalized histogram equals its size"+ propNormalizedHist++ , testProperty "Comparing the same histogram returns a perfect correlation"+ propCorrelation+ , testProperty "Comparing the same histogram returns a 0 chi-square value"+ propChiSquare+ , testProperty+ "The intersection of an histogram with itself is the sum of its values."+ propIntersec+ , testProperty "Comparing the same histogram returns a 0 EMD value"+ propEMD+ ]++-- | The sum of the values of the histogram is equal to the number of pixels of+-- the image.+propCalcHist :: Grey -> Bool+propCalcHist img =+ let Z :. h :. w = I.shape img+ Histogram _ vec = histogram Nothing img+ in V.sum vec == w * h++-- | Checks the identity @histogram == reduce . histogram2D@.+propReduceHist :: Grey -> Bool+propReduceHist img =+ let hist1 = histogram Nothing img :: Histogram DIM1 Int32+ hist2 = reduce (histogram2D (ix3 256 3 3) img)+ in hist1 == hist2++-- | Checks the resizing of an histogram equals the direct computation of the+-- smallest one.+propResizeHist :: Grey -> Bool+propResizeHist img =+ let hist1 = histogram (Just (ix1 128)) img :: Histogram DIM1 Int32+ hist2 = resize (ix1 128) (histogram (Just (ix1 256)) img)+ in hist1 == hist2++-- | Checks if the last bin of the cumulative histogram equals the sum of the+-- values of the original histogram.+propCumulatHist :: Histogram DIM1 Int32 -> Bool+propCumulatHist hist@(Histogram _ vec) =+ let Histogram _ vec' = cumulative hist+ in V.sum vec == vec' V.! 255++-- | Checks that the sums of an equalized histogram equals the desired value.+propNormalizedHist :: Double -> Histogram DIM1 Int32 -> Bool+propNormalizedHist val hist =+ let Histogram _ vec = normalize val hist+ in round (V.sum vec) == (round val :: Integer)++-- | Checks that the comparison of two identical histograms gives the+-- correlation value 1.+propCorrelation :: Histogram DIM1 Int32 -> Bool+propCorrelation hist = round (compareCorrel hist hist :: Double) == (1 :: Int)++-- | Checks that the comparison of two identical histograms gives the zero+-- Chi-square value.+propChiSquare :: Histogram DIM1 Int32 -> Bool+propChiSquare hist = round (compareChi hist hist :: Double) == (0 :: Int)++-- | Checks that the comparison of two identical histograms gives the sum of the+-- values of the histogram.+propIntersec :: Histogram DIM1 Int32 -> Bool+propIntersec hist@(Histogram _ vec) = compareIntersect hist hist == V.sum vec++-- | Checks that the comparison of two identical histograms gives a zero+-- EMD value.+propEMD :: Histogram DIM1 Int32 -> Bool+propEMD hist = compareEMD hist hist == 0
+ test/Test/Vision/Image.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE CPP+ , FlexibleContexts+ , FlexibleInstances+ , TypeFamilies+ , UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.Vision.Image (tests) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<*>), (<$>))+#endif++import Data.Vector.Storable (Storable, replicateM)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Arbitrary (..), choose)++import Vision.Image (+ MaskedImage (..), Image (..), Interpolable, FromFunction (..)+ , ImageChannel, Manifest (..), Delayed (..)+ , Grey, GreyPixel (..), HSVPixel+ , RGBA, RGBAPixel (..), RGBADelayed+ , RGB, RGBPixel (..), InterpolMethod (..)+ , convert, resize, horizontalFlip, verticalFlip+ )+import Vision.Primitive (Z (..), (:.) (..), Size)++maxImageSize :: Int+maxImageSize = 100++instance (Arbitrary p, Storable p) => Arbitrary (Manifest p) where+ arbitrary = do+ w <- choose (1, maxImageSize)+ h <- choose (1, maxImageSize)+ vec <- replicateM (w * h) arbitrary+ return $ Manifest (Z :. h :. w) vec++instance Arbitrary GreyPixel where+ arbitrary = GreyPixel <$> arbitrary++instance Arbitrary RGBAPixel where+ arbitrary = RGBAPixel <$> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary++instance Arbitrary RGBPixel where+ arbitrary = RGBPixel <$> arbitrary <*> arbitrary <*> arbitrary++tests :: [Test]+tests = [+ testGroup "Conversions identities" [+ testProperty "RGB to/from RGBA" $ propRGBRGBA+ , testProperty "RGB to/from HSV" $ propRGBHSV+ ]+ , testGroup "Nearest-neighbor resize" [+ testProperty "Grey" (propImageResize :: Grey -> Bool)+ , testProperty "RGBA" (propImageResize :: RGBA -> Bool)+ , testProperty "RGB" (propImageResize :: RGB -> Bool)+ ]+ , testGroup "Horizontal flip is symetric" [+ testProperty "Grey" (propHorizontalFlip :: Grey -> Bool)+ , testProperty "RGBA" (propHorizontalFlip :: RGBA -> Bool)+ , testProperty "RGB" (propHorizontalFlip :: RGB -> Bool)+ ]+ , testGroup "Vertical flip is symetric" [+ testProperty "Grey" (propVerticalFlip :: Grey -> Bool)+ , testProperty "RGBA" (propVerticalFlip :: RGBA -> Bool)+ , testProperty "RGB" (propVerticalFlip :: RGB -> Bool)+ ]+ ]++-- | Tests if the conversions between RGB and RGBA images give the same images.+propRGBRGBA :: RGB -> Bool+propRGBRGBA img =+ let img' = convert (convert img :: RGBADelayed) :: RGB+ in img == img'++-- | Tests if the conversions between RGB and HSV images give the same images.+propRGBHSV :: RGBPixel -> Bool+propRGBHSV pix =+ same pix pix'+ where+ pix' = convert (convert pix :: HSVPixel) :: RGBPixel++ err = 9++ same (RGBPixel r g b) (RGBPixel r' g' b') =+ abs (r - r') + abs (g - g') + abs (b - b') <= err++-- | Tests if by increasing the size of the image by a factor of two and then+-- reducing by a factor of two give the original image.+propImageResize :: (Image i, FromFunction i, FromFunctionPixel i ~ ImagePixel i+ , Interpolable (ImagePixel i), Integral (ImageChannel i)+ , Eq i)+ => i -> Bool+propImageResize img =+ img == resize' size (resize' (Z :. (h * 2) :. (w * 2)) img)+ where+ size@(Z :. h :. w) = shape img++ resize' :: (Image i, FromFunction i, FromFunctionPixel i ~ ImagePixel i+ , Interpolable (ImagePixel i), Integral (ImageChannel i))+ => Size -> i -> i+ resize' size' = resize NearestNeighbor size'++-- | Tests if applying the horizontal flip twice gives the original image.+propHorizontalFlip :: (Image i, FromFunction i+ , FromFunctionPixel i ~ ImagePixel i, Eq i) => i -> Bool+propHorizontalFlip img =+ img == horizontalFlip (delayedFlip img)+ where+ delayedFlip :: (Image i, ImagePixel i ~ p) => i -> Delayed p+ delayedFlip = horizontalFlip++-- | Tests if applying the vertical flip twice gives the original image.+propVerticalFlip :: (Image i, FromFunction i+ , FromFunctionPixel i ~ ImagePixel i, Eq i) => i -> Bool+propVerticalFlip img =+ img == verticalFlip (delayedFlip img)+ where+ delayedFlip :: (Image i, ImagePixel i ~ p) => i -> Delayed p+ delayedFlip = verticalFlip