Image.hs

{-# 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