Histogram.hs

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