{-# LANGUAGE BangPatterns, FlexibleContexts #-} import Control.Monad.ST.Safe (ST) import Criterion.Main import Data.Int import Data.Word import Vision.Image ( Grey, HSV, RGBA, RGB, RGBDelayed, InterpolMethod ) import qualified Vision.Detector.Edge as D (canny) import qualified Vision.Image as I import Vision.Histogram (Histogram) import qualified Vision.Histogram as H import Vision.Primitive path :: FilePath path = "bench/image.jpg" main :: IO () main = do Right io <- I.load Nothing path let !(Z :. h :. w) = I.shape rgb !halfSize = Rect (w `quot` 2) (h `quot` 2) (w `quot` 2) (h `quot` 2) !rgb = I.convert io :: RGB !rgba = I.convert rgb :: RGBA !grey = I.convert rgb :: Grey !edges = canny' grey !hsv = I.convert rgb :: HSV !hist = H.histogram Nothing grey :: H.Histogram DIM1 Int32 !hist2D = H.histogram2D (ix3 256 3 3) grey :: H.Histogram DIM3 Int32 defaultMain [ bgroup "IO" [ bench "load" $ whnfIO $ I.load Nothing path ] , bgroup "conversion" [ bench "RGB to grey" $ whnf (I.convert :: RGB -> Grey) rgb , bench "RGBA to grey" $ whnf (I.convert :: RGBA -> Grey) rgba , bench "RGBA to RGB" $ whnf (I.convert :: RGBA -> RGB) rgba , bench "RGB to RGBA" $ whnf (I.convert :: RGB -> RGBA) rgb , bench "RGB to HSV" $ whnf (I.convert :: RGB -> HSV) rgb , bench "HSV to RGB" $ whnf (I.convert :: HSV -> RGB) hsv ] , bgroup "crop" [ bench "RGB" $ whnf (I.crop halfSize :: RGB -> RGB) rgb ] , bgroup "detector" [ bench "Canny's edge detector" $ whnf canny' grey ] , bgroup "filter" [ bench "erode" $ whnf erode' grey , bench "blur" $ whnf blur' grey , bench "gaussian blur" $ whnf gaussianBlur' grey , bench "scharr" $ whnf scharr' grey , bench "sobel" $ whnf sobel' grey ] , bgroup "flip" [ bench "horizontal" $ whnf (I.horizontalFlip :: RGB -> RGB) rgb , bench "vertical" $ whnf (I.verticalFlip :: RGB -> RGB) rgb ] , bench "flood-fill" $ whnf floodFill' edges , bgroup "histogram" [ bench "calculate 1D histogram of a grey image" $ whnf (H.histogram Nothing :: Grey -> Histogram DIM1 Int32) grey , bench "calculate 3D histogram of a RGB image" $ whnf (H.histogram Nothing :: RGB -> Histogram DIM3 Int32) rgb , bench "calculate 3D histogram (9 regions) of a grey image" $ whnf (H.histogram2D (ix3 256 3 3) :: Grey -> Histogram DIM3 Int32) grey , bench "reduce an Int32 histogram" $ whnf H.reduce hist2D , bench "resize an Int32 histogram" $ whnf (H.resize (ix1 128)) hist , bench "cumulative Int32 histogram" $ whnf H.cumulative hist , bench "normalize histogram" $ whnf (H.normalize 1 :: Histogram DIM1 Int32 -> Histogram DIM1 Double) hist , bench "equalize grey image" $ whnf (H.equalizeImage :: Grey -> Grey) grey , bench "correlation comparison" $ whnf (H.compareCorrel hist :: Histogram DIM1 Int32 -> Double) hist , bench "chi-square comparison" $ whnf (H.compareChi hist :: Histogram DIM1 Int32 -> Double) hist , bench "intersection comparison" $ whnf (H.compareIntersect hist :: Histogram DIM1 Int32 -> Int32) hist , bench "EMD comparison" $ whnf (H.compareEMD hist) hist , bench "2D correlation comparison" $ whnf (H.compareCorrel hist2D :: Histogram DIM3 Int32 -> Double) hist2D , bench "2D chi-square comparison 2D" $ whnf (H.compareChi hist2D :: Histogram DIM3 Int32 -> Double) hist2D , bench "2D intersection comparison 2D" $ whnf (H.compareIntersect hist2D :: Histogram DIM3 Int32 -> Int32) hist2D ] , bgroup "resize" [ bench "truncate-integer 50%" $ whnf (resize' I.TruncateInteger (ix2 (h `quot` 2) (w `quot` 2))) rgb , bench "truncate-integer 200%" $ whnf (resize' I.TruncateInteger (ix2 (h * 2) (w * 2))) rgb , bench "nearest-neighbor 50%" $ whnf (resize' I.NearestNeighbor (ix2 (h `quot` 2) (w `quot` 2))) rgb , bench "nearest-neighbor 200%" $ whnf (resize' I.NearestNeighbor (ix2 (h * 2) (w * 2))) rgb , bench "bilinear 50%" $ whnf (resize' I.Bilinear (ix2 (h `quot` 2) (w `quot` 2))) rgb , bench "bilinear 200%" $ whnf (resize' I.Bilinear (ix2 (h * 2) (w * 2))) rgb ] , bgroup "threshold" [ bench "simple threshold" $ whnf threshold' grey , bench "adaptive threshold" $ whnf adaptiveThreshold' grey ] , bgroup "application" [ bench "miniature 150x150" $ whnf miniature rgb ] ] where canny' :: Grey -> Grey canny' !img = D.canny 2 256 1024 img erode' :: Grey -> Grey erode' !img = I.erode 1 `I.apply` img blur' :: Grey -> Grey blur' !img = let filt = I.blur 1 :: I.SeparableFilter I.GreyPixel Word32 I.GreyPixel in filt `I.apply` img gaussianBlur' :: Grey -> Grey gaussianBlur' !img = let filt = I.gaussianBlur 1 Nothing :: I.SeparableFilter I.GreyPixel Float I.GreyPixel in filt `I.apply` img sobel' :: Grey -> I.Manifest Int16 sobel' !img = I.sobel 1 I.DerivativeX `I.apply` img scharr' :: Grey -> I.Manifest Int16 scharr' !img = I.scharr I.DerivativeX `I.apply` img floodFill' :: Grey -> I.Grey floodFill' img = I.create $ do mut <- I.thaw img :: ST s (I.MutableManifest I.GreyPixel s) I.floodFill (ix2 5 5) 255 mut return mut resize' :: InterpolMethod -> Size -> RGB -> RGB resize' = I.resize threshold' :: Grey -> Grey threshold' !img = I.threshold (> 127) (I.BinaryThreshold 0 255) img adaptiveThreshold' :: Grey -> Grey adaptiveThreshold' !img = let filt :: I.SeparableFilter I.GreyPixel Float I.GreyPixel filt = I.adaptiveThreshold (I.GaussianKernel Nothing) 1 0 (I.BinaryThreshold 0 255) in filt `I.apply` img miniature !rgb = let Z :. h :. w = I.shape rgb in if w > h then resizeSquare $ I.crop (Rect ((w - h) `quot` 2) 0 h h) rgb else resizeSquare $ I.crop (Rect 0 ((h - w) `quot` 2) w w) rgb resizeSquare :: RGBDelayed -> RGB resizeSquare = I.resize I.Bilinear (Z :. 150 :. 150)