friday 0.1.5 → 0.2.0.1

raw patch · 31 files changed

+1453/−1840 lines, 31 filesdep +deepseqdep −criteriondep ~bytestringdep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependencies removed: criterion

Dependency ranges changed: bytestring, vector

API changes (from Hackage documentation)

Files

• bench/Benchmark.hs +0/−190
• example/Canny.hs +0/−39
• example/Delayed.hs +0/−44
• example/GaussianBlur.hs +0/−35
• example/Histogram.hs +0/−46
• example/ResizeImage.hs +0/−28
• example/Threshold.hs +0/−18
• friday.cabal +14/−102
• src/Vision/Detector/Edge.hs +15/−11
• src/Vision/Histogram.hs +20/−9
• src/Vision/Image.hs +3/−3
• src/Vision/Image/Class.hs +230/−0
• src/Vision/Image/Filter.hs +90/−623
• src/Vision/Image/Filter/Internal.hs +758/−0
• src/Vision/Image/Grey/Conversion.hs +2/−1
• src/Vision/Image/Grey/Specialize.hs +55/−4
• src/Vision/Image/Grey/Type.hs +5/−2
• src/Vision/Image/HSV/Conversion.hs +3/−1
• src/Vision/Image/HSV/Type.hs +6/−2
• src/Vision/Image/Interpolate.hs +3/−2
• src/Vision/Image/Mutable.hs +18/−12
• src/Vision/Image/RGB/Conversion.hs +2/−1
• src/Vision/Image/RGB/Type.hs +6/−2
• src/Vision/Image/RGBA/Conversion.hs +2/−1
• src/Vision/Image/RGBA/Type.hs +6/−2
• src/Vision/Image/Storage.hsc +0/−381
• src/Vision/Image/Threshold.hs +150/−32
• src/Vision/Image/Transform.hs +11/−9
• src/Vision/Image/Type.hs +42/−239
• src/Vision/Primitive.hs +9/−0
• src/Vision/Primitive/Shape.hs +3/−1

@@ -1,190 +0,0 @@-{-# 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-            , bench "Otsu's method"      $ whnf otsu'              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--    otsu' :: Grey -> Grey-    otsu' !img = I.otsu (I.BinaryThreshold 0 255) 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)

@@ -1,39 +0,0 @@-import Prelude hiding (filter)-import System.Environment (getArgs)--import Vision.Detector.Edge (canny)-import Vision.Image---- Detects the edge of the image with the Canny's edge detector.------ usage: ./canny input.png output.png-main :: IO ()-main = do-    [input, output] <- getArgs--    -- Loads the image. Automatically infers the format.-    io <- load Nothing input--    case io of-        Left _err -> putStrLn "Error while reading the image."-        Right img -> do-            let -- Convert the StorageImage (which can be Grey, RGB or RGBA) to-                -- a Grey image (edges are detected on greyscale images).-                grey = convert img              :: Grey--                -- Creates a Gaussian filter with a 3x3 kernel to remove small-                -- noises.-                filter = gaussianBlur 1 Nothing :: SeparableFilter GreyPixel-                                                                   Float-                                                                   GreyPixel--                -- Applies the Gaussian filter to the grey-scale image.-                blurred = apply filter grey     :: Grey--                -- Applies the Canny's algorithm with a 5x5 Sobel kernel (radius-                -- = 2).-                edges = canny 2 256 1024 blurred  :: Grey--            -- Saves the edges image. Ignores any runtime error.-            _ <- save output edges-            return ()

@@ -1,44 +0,0 @@-import System.Environment (getArgs)--import Vision.Image-import Vision.Primitive (Z (..), (:.) (..), Rect (..), ix2)---- Reads an image from a file, applies a composition of transformations to--- create a centred and squared miniature and then writes the result to a file:------ usage: ./delayed input.png output.png-main :: IO ()-main = do-    [input, output] <- getArgs--    -- Loads the image. Automatically infers the format.-    io <- load Nothing input--    case io of-        Left _err -> putStrLn "Error while reading the image."-        Right img -> do-            let -- Convert the StorageImage (which can be Grey, RGB or RGBA) to-                -- an RGB image.-                rgb = convert img :: RGB--                -- Gets the size of the image.-                Z :. h :. w = shape rgb--                -- Creates a Rect object which will be used to define how we-                -- will crop our image. The rectangle is centered on the largest-                -- side of the image.-                rect | w > h     = Rect ((w - h) `quot` 2) 0 h h-                     | otherwise = Rect 0 ((h - w) `quot` 2) w w--                -- Crops the image. Doesn't compute the image into a "real"-                -- image: by using a delayed representation, this intermediate-                -- image will not exist in the computer memory as a large array.-                cropped = delayed $ crop rect rgb--                -- Resizes the image. By using the delayed representation of the-                -- cropped image, our compiler should be able to fuse these two-                -- transformations into a single loop.-                resized = manifest $ resize Bilinear (ix2 250 250) cropped--            _ <- save output resized-            return ()

@@ -1,35 +0,0 @@-import Prelude hiding (filter)-import System.Environment (getArgs)--import Vision.Image---- Applies a Gaussian blur to an image.------ usage: ./gaussian_blur input.png output.png-main :: IO ()-main = do-    [input, output] <- getArgs--    -- Loads the image. Automatically infers the format.-    io <- load Nothing input--    case io of-        Left _err -> putStrLn "Error while reading the image."-        Right img -> do-            let -- Convert the StorageImage (which can be Grey, RGB or RGBA) to-                -- a Grey image (filters are currently only supported on single-                -- channel images).-                grey = convert img              :: Grey--                -- Creates a Gaussian filter with a 21x21 kernel (kernel radius-                -- of 10px).-                filter = gaussianBlur 10 Nothing :: SeparableFilter GreyPixel-                                                                    Float-                                                                    GreyPixel--                -- Applies the filter to the grey-scale image.-                blurred = apply filter grey     :: Grey--            -- Saves the blurred image. Ignores any runtime error.-            _ <- save output blurred-            return ()

@@ -1,46 +0,0 @@-import Data.Int-import System.Environment (getArgs)-import Text.Printf--import Vision.Histogram-import Vision.Image-import Vision.Primitive---- Compares two images by their HSV histograms.------ usage: ./histogram input1.png input2.png-main :: IO ()-main = do-    [input1, input2] <- getArgs--    -- Loads the images. Automatically infers the format.-    io1 <- load Nothing input1-    io2 <- load Nothing input2--    case (io1, io2) of-        (Right img1, Right img2) -> do-            let rgb1 = convert img1 :: RGB-                rgb2 = convert img2 :: RGB--                -- Converts both images to the HSV color space as it gives-                -- better results when comparing colors.-                hsv1 = convert rgb1 :: HSV-                hsv2 = convert rgb2 :: HSV--                -- Computes a small histogram so two colors which are similar-                -- will be in the same bin.-                histSize = Just $ ix3 10 5 5--                hist1 = histogram histSize hsv1 :: Histogram DIM3 Int32-                hist2 = histogram histSize hsv2 :: Histogram DIM3 Int32--                -- Normalizes both histograms as the number of pixels in the two-                -- images could be different.-                hist1' = normalize 100 hist1    :: Histogram DIM3 Double-                hist2' = normalize 100 hist2    :: Histogram DIM3 Double--                intersec = compareIntersect hist1' hist2'--            printf "The two images share %.2f%% of their colors.\n" intersec--        _ -> putStrLn "Error while reading the images."

@@ -1,28 +0,0 @@-import System.Environment (getArgs)--import Vision.Image-import Vision.Primitive (ix2)---- Resizes the input image to a square of 250x250 pixels.------ usage: ./resize_image input.png output.png-main :: IO ()-main = do-    [input, output] <- getArgs--    -- Loads the image. Automatically infers the format.-    io <- load Nothing input--    case io of-        Left _err -> putStrLn "Error while reading the image."-        Right img -> do-            let -- Convert the StorageImage (which can be Grey, RGB or RGBA) to-                -- an RGB image.-                rgb = convert img                             :: RGB--                -- Resizes the RGB image to 250x250 pixels.-                miniature = resize Bilinear (ix2 250 250) rgb :: RGB--            -- Saves the miniature. Ignores any runtime error.-            _ <- save output miniature-            return ()

@@ -1,18 +0,0 @@-import System.Environment (getArgs)--import Vision.Image---- Thresholds an image by applying the Otsu's method.------ usage: ./threshold .png output.png-main :: IO ()-main = do-    [input, output] <- getArgs-    io <-     either (\x -> error $ "Load failed: " ++ show x) return-          =<< load Nothing input--    let grey        = convert io                        :: Grey-        thresholded = otsu (BinaryThreshold 0 255) grey :: Grey--    _ <- save output thresholded-    return ()

@@ -1,6 +1,9 @@ name:                   friday-version:                0.1.5-synopsis:               A functionnal image processing library for Haskell.+--                      +-+------- breaking API changes+--                      | | +----- non-breaking API additions+--                      | | | +--- code changes with no API change+version:                0.2.0.1+synopsis:               A functional image processing library for Haskell. homepage:               https://github.com/RaphaelJ/friday license:                LGPL-3 license-file:           LICENSE@@ -12,11 +15,6 @@                         The library is designed to be fast, generic and                         type-safe.                         .-                        The library uses FFI calls to the DevIL image library to-                        read images from a wide variety of formats, including-                        BMP, JPG, PNG, GIF, ICO and PSD. Except for I/Os, friday-                        is entirely written in Haskell.-                        .                         Images can be represented in two representations:                         .                         * the 'Manifest' representation stores images in Haskell@@ -40,19 +38,21 @@ build-type:             Simple cabal-version:          >= 1.10 -Flag examples-    Description:   Compiles examples from the example/ directory.-    Default:       False+source-repository       head+    type:               git+    location:           https://github.com/RaphaelJ/friday  library     exposed-modules:    Vision.Detector.Edge                         Vision.Histogram                         Vision.Image+                        Vision.Image.Class                         Vision.Image.Grey                         Vision.Image.Grey.Conversion                         Vision.Image.Grey.Specialize                         Vision.Image.Grey.Type                         Vision.Image.Filter+                        Vision.Image.Filter.Internal                         Vision.Image.HSV                         Vision.Image.HSV.Conversion                         Vision.Image.HSV.Specialize@@ -67,7 +67,6 @@                         Vision.Image.RGB.Conversion                         Vision.Image.RGB.Specialize                         Vision.Image.RGB.Type-                        Vision.Image.Storage                         Vision.Image.Threshold                         Vision.Image.Transform                         Vision.Image.Type@@ -79,101 +78,14 @@     default-language:   Haskell2010      build-depends:      base                    >= 4            && < 5-                      , bytestring              >= 0.10         && < 1.0+                      , bytestring              >= 0.10         && < 1                       , convertible             >= 1            && < 2+                      , deepseq                 >= 1.3          && < 2                       , primitive               >= 0.5.2.1      && < 0.6                       , ratio-int               >= 0.1.2        && < 0.2-                      , vector                  >= 0.10.0.1     && < 1.0+                      , vector                  >= 0.10.0.1     && < 1                       , transformers            >= 0.3          && < 0.5 -    Build-tools:        hsc2hs--    Extra-Libraries:    IL--executable      delayed-    if !flag(examples)-        Buildable: False--    main-is:            Delayed.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     example/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , friday--executable      canny-    if !flag(examples)-        Buildable: False--    main-is:            Canny.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     example/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , friday--executable      gaussian_blur-    if !flag(examples)-        Buildable: False--    main-is:            GaussianBlur.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     example/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , friday--executable      histogram-    if !flag(examples)-        Buildable: False--    main-is:            Histogram.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     example/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , friday--executable      resize_image-    if !flag(examples)-        Buildable: False--    main-is:            ResizeImage.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     example/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , friday--executable      threshold-    if !flag(examples)-        Buildable: False--    main-is:            Threshold.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     example/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , friday--Benchmark       benchmark-    type:               exitcode-stdio-1.0--    main-is:            Benchmark.hs-    ghc-options:        -Wall -O2 -rtsopts-    hs-source-dirs:     bench/-    default-language:   Haskell2010--    build-depends:      base                    >= 4            && < 5-                      , criterion               >= 1.0          && < 2.0-                      , friday- Test-Suite      test     type:       exitcode-stdio-1.0 @@ -187,4 +99,4 @@                       , friday                       , test-framework               >= 0.8          && < 0.9                       , test-framework-quickcheck2   >= 0.3.0.2      && < 0.4-                      , vector                       >= 0.10.0.1     && < 1.0+                      , vector                       >= 0.10.0.1     && < 1

@@ -1,4 +1,6 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, MultiWayIf #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , MultiWayIf #-}  module Vision.Detector.Edge (canny) where @@ -6,12 +8,13 @@ import Control.Monad.ST.Safe (ST) import Data.Int import Data.Vector.Storable (enumFromN, forM_)+import Foreign.Storable (Storable)  import Vision.Image (-      Image, Pixel, ImagePixel, Manifest, MutableManifest, Grey, Derivative (..)-    , shape, index, linearIndex, fromFunction+      Image, ImagePixel, Manifest, MutableManifest, Grey, DerivativeType (..)+    , (!), shape, linearIndex, fromFunction     , create, new', linearRead, linearWrite-    , apply, sobel+    , sobel     ) import Vision.Primitive (Z (..), (:.) (..), inShape, ix2) @@ -34,7 +37,8 @@ -- -- This function is specialized for 'Grey' images but is declared @INLINABLE@ -- to be further specialized for new image types.-canny :: (Image src, Integral (ImagePixel src), Bounded res, Eq res, Pixel res)+canny :: ( Image src, Integral (ImagePixel src), Bounded res, Eq res+         , Storable res)       => Int       -- ^ Radius of the Sobel's filter.       -> Int32@@ -62,16 +66,16 @@     (!lowThres', !highThres') = (square lowThres, square highThres)      dx, dy :: Manifest Int16-    !dx = sobel derivSize DerivativeX `apply` img-    !dy = sobel derivSize DerivativeY `apply` img+    !dx = sobel derivSize DerivativeX img+    !dy = sobel derivSize DerivativeY img      -- Gradient magnitude, squared.     dxy :: Manifest Int32     !dxy = fromFunction size $ \pt ->-                  square (fromIntegral $ dx `index` pt)-                + square (fromIntegral $ dy `index` pt)+                  square (fromIntegral $ dx ! pt)+                + square (fromIntegral $ dy ! pt) -    newManifest :: (Pixel p, Bounded p) => ST s (MutableManifest p s)+    newManifest :: (Storable p, Bounded p) => ST s (MutableManifest p s)     newManifest = new' size minBound      -- Visits a point and compares its gradient magnitude to the given@@ -118,7 +122,7 @@         in tryCompare ptDxy (>) (x1, y1) && tryCompare ptDxy (>=) (x2, y2)      tryCompare !ptDxy op !(x, y)-        | inShape size (ix2 y x) = ptDxy `op` fromIntegral (dxy `index` ix2 y x)+        | inShape size (ix2 y x) = ptDxy `op` fromIntegral (dxy ! ix2 y x)         | otherwise              = True      -- Returns the direction of the edge, not to be confused with the direction

@@ -1,5 +1,9 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances-           , ParallelListComp, TypeFamilies, TypeOperators #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , FlexibleInstances+           , ParallelListComp+           , TypeFamilies+           , TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | Contains functions to compute and manipulate histograms as well as some@@ -11,7 +15,7 @@ module Vision.Histogram (     -- * Types & helpers       Histogram (..), HistogramShape (..), ToHistogram (..)-    , index, linearIndex, map, assocs, pixToBin+    , index, (!), linearIndex, map, assocs, pixToBin     -- * Histogram computations     , histogram,  histogram2D, reduce, resize, cumulative, normalize     -- * Images processing@@ -21,21 +25,23 @@     ) where  import Data.Int-import Data.Vector.Storable (Vector, (!))-import qualified Data.Vector.Storable as V+import Data.Vector.Storable (Vector) import Foreign.Storable (Storable) import Prelude hiding (map) +import qualified Data.Vector.Storable as V++import Vision.Image.Class (Pixel, MaskedImage, Image, ImagePixel, FunctorImage) import Vision.Image.Grey.Type (GreyPixel (..)) import Vision.Image.HSV.Type  (HSVPixel (..)) import Vision.Image.RGBA.Type (RGBAPixel (..)) import Vision.Image.RGB.Type  (RGBPixel (..))-import Vision.Image.Type (Pixel, MaskedImage, Image, ImagePixel, FunctorImage)-import qualified Vision.Image.Type as I import Vision.Primitive (       Z (..), (:.) (..), Shape (..), DIM1, DIM3, DIM4, DIM5, ix1, ix3, ix4     ) +import qualified Vision.Image.Class as I+ -- There is no rule to simplify the conversion from Int32 to Double and Float -- when using realToFrac. Both conversions are using a temporary yet useless -- Rational value.@@ -128,10 +134,15 @@ index !hist = linearIndex hist . toLinearIndex (shape hist) {-# INLINE index #-} +-- | Alias of 'index'.+(!) :: (Shape sh, Storable a) => Histogram sh a -> sh -> a+(!) = index+{-# INLINE (!) #-}+ -- | Returns the value at the index as if the histogram was a single dimension -- vector (row-major representation). linearIndex :: (Shape sh, Storable a) => Histogram sh a -> Int -> a-linearIndex !hist = (!) (vector hist)+linearIndex !hist = (V.!) (vector hist) {-# INLINE linearIndex #-}  map :: (Storable a, Storable b) => (a -> b) -> Histogram sh a -> Histogram sh b@@ -306,7 +317,7 @@     Z :. nBins      = shape hist     cumNormalized   = cumulative $ normalize (double nBins) hist     !cumNormalized' = map round cumNormalized           :: Histogram DIM1 Int32-    equalizePixel !val = fromIntegral $ cumNormalized' `index` ix1 (int val)+    equalizePixel !val = fromIntegral $ cumNormalized' ! ix1 (int val)     {-# INLINE equalizePixel #-} {-# INLINABLE equalizeImage #-} 

@@ -13,19 +13,20 @@ -- <https://github.com/RaphaelJ/friday/blob/master/README.md README file> for a -- detailed usage and examples. module Vision.Image (-      module Vision.Image.Grey+      module Vision.Image.Class+    , module Vision.Image.Grey     , module Vision.Image.Filter     , module Vision.Image.HSV     , module Vision.Image.Interpolate     , module Vision.Image.Mutable     , module Vision.Image.RGB     , module Vision.Image.RGBA-    , module Vision.Image.Storage     , module Vision.Image.Threshold     , module Vision.Image.Transform     , module Vision.Image.Type     ) where +import Vision.Image.Class import Vision.Image.Grey import Vision.Image.Filter import Vision.Image.HSV@@ -33,7 +34,6 @@ import Vision.Image.Mutable import Vision.Image.RGB import Vision.Image.RGBA-import Vision.Image.Storage import Vision.Image.Threshold import Vision.Image.Transform import Vision.Image.Type

@@ -0,0 +1,230 @@+{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses+           , TypeFamilies #-}++module Vision.Image.Class (+    -- * Classes+      Pixel (..), MaskedImage (..), Image (..), ImageChannel, FromFunction (..)+    , FunctorImage (..)+    -- * Functions+    , (!), (!?), nChannels, pixel+    -- * Conversion+    , Convertible (..), convert+    ) where++import Data.Convertible (Convertible (..), convert)+import Data.Int+import Data.Vector.Storable (Vector, generate, unfoldr)+import Data.Word+import Foreign.Storable (Storable)+import Prelude hiding (map, read)++import Vision.Primitive (+      Z (..), (:.) (..), Point, Size+    , fromLinearIndex, toLinearIndex, shapeLength+    )++-- Classes ---------------------------------------------------------------------++-- | Determines the number of channels and the type of each pixel of the image+-- and how images are represented.+class Pixel p where+    type PixelChannel p++    -- | Returns the number of channels of the pixel.+    -- Must not consume 'p' (could be 'undefined').+    pixNChannels :: p -> Int++    pixIndex :: p -> Int -> PixelChannel p++instance Pixel Int16 where+    type PixelChannel Int16 = Int16+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Int32 where+    type PixelChannel Int32 = Int32+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Int where+    type PixelChannel Int = Int+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Word8 where+    type PixelChannel Word8 = Word8+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Word16 where+    type PixelChannel Word16 = Word16+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Word32 where+    type PixelChannel Word32 = Word32+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Word where+    type PixelChannel Word = Word+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Float where+    type PixelChannel Float = Float+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Double where+    type PixelChannel Double = Double+    pixNChannels _   = 1+    pixIndex     p _ = p++instance Pixel Bool where+    type PixelChannel Bool = Bool+    pixNChannels _   = 1+    pixIndex     p _ = p++-- | Provides an abstraction for images which are not defined for each of their+-- pixels. The interface is similar to 'Image' except that indexing functions+-- don't always return.+--+-- Image origin (@'ix2' 0 0@) is located in the upper left corner.+class Storable (ImagePixel i) => MaskedImage i where+    type ImagePixel i++    shape :: i -> Size++    -- | Returns the pixel\'s value at 'Z :. y, :. x'.+    maskedIndex :: i -> Point -> Maybe (ImagePixel i)+    maskedIndex img = (img `maskedLinearIndex`) . toLinearIndex (shape img)+    {-# INLINE maskedIndex #-}++    -- | Returns the pixel\'s value as if the image was a single dimension+    -- vector (row-major representation).+    maskedLinearIndex :: i -> Int -> Maybe (ImagePixel i)+    maskedLinearIndex img = (img `maskedIndex`) . fromLinearIndex (shape img)+    {-# INLINE maskedLinearIndex #-}++    -- | Returns the non-masked values of the image.+    values :: i -> Vector (ImagePixel i)+    values !img =+        unfoldr step 0+      where+        !n = shapeLength (shape img)++        step !i | i >= n                              = Nothing+                | Just p <- img `maskedLinearIndex` i = Just (p, i + 1)+                | otherwise                           = step (i + 1)+    {-# INLINE values #-}++    {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-}++type ImageChannel i = PixelChannel (ImagePixel i)++-- | Provides an abstraction over the internal representation of an image.+-- Image origin is located in the lower left corner.+class MaskedImage i => Image i where+    -- | Returns the pixel value at 'Z :. y :. x'.+    index :: i -> Point -> ImagePixel i+    index img = (img `linearIndex`) . toLinearIndex (shape img)+    {-# INLINE index #-}++    -- | Returns the pixel value as if the image was a single dimension vector+    -- (row-major representation).+    linearIndex :: i -> Int -> ImagePixel i+    linearIndex img = (img `index`) . fromLinearIndex (shape img)+    {-# INLINE linearIndex #-}++    -- | Returns every pixel values as if the image was a single dimension+    -- vector (row-major representation).+    vector :: i -> Vector (ImagePixel i)+    vector img = generate (shapeLength $ shape img) (img `linearIndex`)+    {-# INLINE vector #-}++    {-# MINIMAL index | linearIndex #-}++-- | Provides ways to construct an image from a function.+class FromFunction i where+    type FromFunctionPixel i++    -- | Generates an image by calling the given function for each pixel of the+    -- constructed image.+    fromFunction :: Size -> (Point -> FromFunctionPixel i) -> i++    -- | Generates an image by calling the last function for each pixel of the+    -- constructed image.+    -- The first function is called for each line, generating a line invariant+    -- value.+    -- This function is faster for some image representations as some recurring+    -- computation can be cached.+    fromFunctionLine :: Size -> (Int -> a)+                     -> (a -> Point -> FromFunctionPixel i) -> i+    fromFunctionLine size line f =+        fromFunction size (\pt@(Z :. y :. _) -> f (line y) pt)+    {-# INLINE fromFunctionLine #-}++    -- | Generates an image by calling the last function for each pixel of the+    -- constructed image.+    -- The first function is called for each column, generating a column+    -- invariant value.+    -- This function *can* be faster for some image representations as some+    -- recurring computations can be cached. However, it may requires a vector+    -- allocation for these values. If the column invariant is cheap to+    -- compute, prefer 'fromFunction'.+    fromFunctionCol :: Storable b => Size -> (Int -> b)+                    -> (b -> Point -> FromFunctionPixel i) -> i+    fromFunctionCol size col f =+        fromFunction size (\pt@(Z :. _ :. x) -> f (col x) pt)+    {-# INLINE fromFunctionCol #-}++    -- | Generates an image by calling the last function for each pixel of the+    -- constructed image.+    -- The two first functions are called for each line and for each column,+    -- respectively, generating common line and column invariant values.+    -- This function is faster for some image representations as some recurring+    -- computation can be cached. However, it may requires a vector+    -- allocation for column values. If the column invariant is cheap to+    -- compute, prefer 'fromFunctionLine'.+    fromFunctionCached :: Storable b => Size+                       -> (Int -> a)               -- ^ Line function+                       -> (Int -> b)               -- ^ Column function+                       -> (a -> b -> Point+                           -> FromFunctionPixel i) -- ^ Pixel function+                       -> i+    fromFunctionCached size line col f =+        fromFunction size (\pt@(Z :. y :. x) -> f (line y) (col x) pt)+    {-# INLINE fromFunctionCached #-}++    {-# MINIMAL fromFunction #-}++-- | Defines a class for images on which a function can be applied. The class is+-- different from 'Functor' as there could be some constraints and+-- transformations the pixel and image types.+class (MaskedImage src, MaskedImage res) => FunctorImage src res where+    map :: (ImagePixel src -> ImagePixel res) -> src -> res++-- Functions -------------------------------------------------------------------++-- | Alias of 'maskedIndex'.+(!?) :: MaskedImage i => i -> Point -> Maybe (ImagePixel i)+(!?) = maskedIndex+{-# INLINE (!?) #-}++-- | Alias of 'index'.+(!) :: Image i => i -> Point -> ImagePixel i+(!) = index+{-# INLINE (!) #-}++-- | Returns the number of channels of an image.+nChannels :: (Pixel (ImagePixel i), MaskedImage i) => i -> Int+nChannels img = pixNChannels (pixel img)+{-# INLINE nChannels #-}++-- | Returns an 'undefined' instance of a pixel of the image. This is sometime+-- useful to satisfy the type checker as in a call to 'pixNChannels' :+--+-- > nChannels img = pixNChannels (pixel img)+pixel :: MaskedImage i => i -> ImagePixel i+pixel _ = undefined

@@ -1,8 +1,11 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances, GADTs-           , MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , TypeFamilies #-} --- | Provides high level functions to define and apply filters on images.+-- | Provides high level filtering functions for images. --+-- Use 'Vision.Image.Filter.Internal' if you want to create new image filters.+-- -- Filters are operations on images on which the surrounding of each processed -- pixel is considered according to a kernel. --@@ -11,607 +14,86 @@ -- The @radius@ argument of some filters is used to determine the kernel size. -- A radius as of 1 means a kernel of size 3, 2 a kernel of size 5 and so on. ----- The @acc@ type argument of some filters defines the type which will be used--- to store the accumulated value of the kernel (e.g. by setting @acc@ to--- 'Double' in the computation of a Gaussian blur, the kernel average will be--- computed using a 'Double').------ To apply a filter to an image, use the 'apply' method:------ @--- let filter :: 'SeparableFilter' GreyPixel Double GreyPixel---     filter = 'gaussianBlur' 2 Nothing--- in 'apply' filter img :: Grey--- @+-- /Note:/ filters are currently not supported on multi-channel images (RGB,+-- RGBA ...) are currently not supported. module Vision.Image.Filter (-    -- * Types-      Filterable (..), Filter (..)-    , BoxFilter, BoxFilter1, SeparableFilter, SeparableFilter1-    , KernelAnchor (..)-    , Kernel (..)-    , SeparableKernel (..), SeparatelyFiltrable (..)-    , FilterFold (..), FilterFold1 (..)-    , BorderInterpolate (..)-    -- * Functions-    , kernelAnchor, borderInterpolate-    -- * Filters-    -- ** Morphological operators+    -- * Classes and type+      Filterable, Filter, SeparatelyFiltrable+    -- * Morphological operators     , dilate, erode-    -- ** Blur+    -- * Blur     , blur, gaussianBlur-    -- ** Derivation-    , Derivative (..), scharr, sobel+    -- * Derivation+    , DerivativeType (..), scharr, sobel+    -- * Others+    , mean     ) where -import Data.List-import Data.Ratio-import qualified Data.Vector.Storable as V-import Data.Word+import Data.Int import Foreign.Storable (Storable) -import Vision.Image.Type (-      MaskedImage (..), Image (..), FromFunction (..)-    , Manifest, Delayed+import Vision.Image.Class (MaskedImage (..), Image (..), FromFunction (..))+import Vision.Image.Filter.Internal (+      Filterable, Filter, SeparatelyFiltrable (..)+    , DerivativeType     )-import Vision.Primitive (Z (..), (:.) (..), DIM1, DIM2, Size, ix1, ix2)---- Types --------------------------------------------------------------------------- | Provides an implementation to execute a type of filter.------ 'src' is the original image, 'res' the resulting image and 'f' the filter.-class Filterable src res f where-    -- | Applies the given filter on the given image.-    apply :: f -> src -> res--data Filter src kernel init acc res = Filter {-      fKernelSize   :: !Size-    , fKernelCenter :: !KernelAnchor-    -- | See 'Kernel' and 'SeparableKernel'.-    , fKernel       :: !kernel-    -- | Defines how the accumulated value is initialized.-    ---    -- See 'FilterFold' and 'FilterFold1'.-    , fInit         :: !init-    , fPost         :: !(src -> acc -> res)-    , fInterpol     :: !(BorderInterpolate src)-    }---- | 2D filters which are initialized with a value.-type BoxFilter src acc res       = Filter src (Kernel src acc) (FilterFold acc)-                                          acc res---- | 2D filters which are not initialized with a value.-type BoxFilter1 src res          = Filter src (Kernel src src) FilterFold1 src-                                          res---- | Separable 2D filters which are initialized with a value.-type SeparableFilter src acc res = Filter src (SeparableKernel src acc)-                                          (FilterFold acc) acc res---- | Separable 2D filters which are not initialized with a value.-type SeparableFilter1 src res    = Filter src (SeparableKernel src src)-                                          FilterFold1 src res---- | Defines how the center of the kernel will be determined.-data KernelAnchor = KernelAnchor !DIM2 | KernelAnchorCenter---- | A simple 2D kernel.------ The kernel function accepts the coordinates in the kernel, the value of the--- pixel at these coordinates ('src'), the current accumulated value and returns--- a new accumulated value.------ Non-separable filters computational complexity grows quadratically according--- to the size of the sides of the kernel.-newtype Kernel src acc = Kernel (DIM2 -> src -> acc -> acc)---- | Some kernels can be factorized in two uni-dimensional kernels (horizontal--- and vertical).------ Separable filters computational complexity grows linearly according to the--- size of the sides of the kernel.------ See <http://http://en.wikipedia.org/wiki/Separable_filter>.-data SeparableKernel src acc = SeparableKernel {-    -- | Vertical (column) kernel.-      skVertical   :: !(DIM1 -> src -> acc -> acc)-    -- | Horizontal (row) kernel.-    , skHorizontal :: !(DIM1 -> acc -> acc -> acc)-    }---- | Used to determine the type of the accumulator image used when computing--- separable filters.------ 'src' and 'res' are respectively the source and the result image types while--- 'acc' is the pixel type of the accumulator.-class SeparatelyFiltrable src res acc where-    type SeparableFilterAccumulator src res acc--instance SeparatelyFiltrable src (Manifest p) acc where-    type SeparableFilterAccumulator src (Manifest p) acc = Manifest acc--instance SeparatelyFiltrable src (Delayed p) acc where-    type SeparableFilterAccumulator src (Delayed p) acc = Delayed acc---- | Uses an initial value to initialize the filter.-data FilterFold acc = FilterFold acc---- | Uses the first pixel in the kernel as initial value. The kernel must not be--- empty and the accumulator type must be the same as the source pixel type.------ This kind of initialization is needed by morphological filters.-data FilterFold1 = FilterFold1---- | Defines how image boundaries are extrapolated by the algorithms.------ '|' characters in examples are image borders.-data BorderInterpolate a =-    -- | Replicates the first and last pixels of the image.-    ---    -- > aaaaaa|abcdefgh|hhhhhhh-      BorderReplicate-    -- | Reflects the border of the image.-    ---    -- > fedcba|abcdefgh|hgfedcb-    | BorderReflect-    -- | Considers that the last pixel of the image is before the first one.-    ---    -- > cdefgh|abcdefgh|abcdefg-    | BorderWrap-    -- | Assigns a constant value to out of image pixels.-    ---    -- > iiiiii|abcdefgh|iiiiiii  with some specified 'i'-    | BorderConstant !a---- Instances ----------------------------------------------------------------------- Following implementations share a lot of similar processing. However, GHC--- fails to specialise and optimise correctly when goXXX functions are top-level--- functions, even with static argument transformations.---- | Box filters initialized with a given value.-instance (Image src, FromFunction res, src_p ~ ImagePixel src-        , res_p ~ FromFunctionPixel res)-        => Filterable src res (BoxFilter src_p acc res_p) where-    apply !(Filter ksize anchor (Kernel kernel) ini post interpol) !img =-        let !(FilterFold acc)  = ini-        in fromFunction size $ \(!pt@(Z :. iy :. ix)) ->-            let !iy0  = iy - kcy-                !ix0  = ix - kcx-                !safe =    iy0 >= 0 && iy0 + kh <= ih-                        && ix0 >= 0 && ix0 + kw <= iw-                !pix  = img `index` pt-            in post pix $! if safe then goColumnSafe (iy0 * iw) ix0 0 acc-                                   else goColumn     iy0        ix0 0 acc-      where-        !size@(Z :. ih :. iw) = shape img--        !(Z :. kh  :. kw)  = ksize-        !(Z :. kcy :. kcx) = kernelAnchor anchor ksize--        goColumn !iy !ix !ky !acc-            | ky < kh   = case borderInterpolate interpol ih iy of-                            Left  iy' -> goLine iy (iy' * iw) ix ix ky 0 acc-                            Right val -> goLineConst iy ix ky 0 val acc-            | otherwise = acc--        goColumnSafe !linearIY !ix !ky !acc-            | ky < kh   = goLineSafe linearIY ix ix ky 0 acc-            | otherwise = acc--        goLine !iy !linearIY !ix0 !ix !ky !kx !acc-            | kx < kw   =-                let !val  = case borderInterpolate interpol iw ix of-                                Left  ix'  -> img `linearIndex` (linearIY + ix')-                                Right val' -> val'-                    !acc' = kernel (ix2 ky kx) val acc-                in goLine iy linearIY ix0 (ix + 1) ky (kx + 1) acc'-            | otherwise = goColumn (iy + 1) ix0 (ky + 1) acc--        goLineSafe !linearIY !ix0 !ix !ky !kx !acc-            | kx < kw   =-                let !val  = img `linearIndex` (linearIY + ix)-                    !acc' = kernel (ix2 ky kx) val acc-                in goLineSafe linearIY ix0 (ix + 1) ky (kx + 1) acc'-            | otherwise = goColumnSafe (linearIY + iw) ix0 (ky + 1) acc--        goLineConst !iy !ix !ky !kx !val !acc-            | kx < kw   = let !acc' = kernel (ix2 ky kx) val acc-                          in goLineConst iy ix ky (kx + 1) val acc'-            | otherwise = goColumn (iy + 1) ix (ky + 1) acc-    {-# INLINE apply #-}---- | Box filters initialized using the first pixel of the kernel.-instance (Image src, FromFunction res, src_p ~ ImagePixel src-        , res_p ~ FromFunctionPixel res)-        => Filterable src res (BoxFilter1 src_p res_p) where-    apply !(Filter ksize anchor (Kernel kernel) _ post interpol) !img-        | kh == 0 || kw == 0 =-            error "Using FilterFold1 with an empty kernel."-        | otherwise          =-            fromFunction size $ \(!pt@(Z :. iy :. ix)) ->-                let !iy0  = iy - kcy-                    !ix0  = ix - kcx-                    !safe =    iy0 >= 0 && iy0 + kh <= ih-                            && ix0 >= 0 && ix0 + kw <= iw-                    !pix  = img `index` pt-                in post pix $! if safe then goColumn1Safe iy0 ix0-                                       else goColumn1     iy0 ix0-      where-        !size@(Z :. ih :. iw) = shape img--        !(Z :. kh  :. kw)  = ksize-        !(Z :. kcy :. kcx) = kernelAnchor anchor ksize--        goColumn1 !iy !ix =-            case borderInterpolate interpol ih iy of-                Left  iy' ->-                    let !linearIY = iy' * iw-                        !acc      = safeIndex linearIY ix-                    in goLine iy linearIY ix (ix + 1) 0 1 acc-                Right val -> goLineConst iy ix 0 1 val val--        goColumn1Safe !iy !ix =-            let !linearIY = iy * iw-                !acc      = img `linearIndex` (linearIY + ix)-            in goLineSafe linearIY ix (ix + 1) 0 1 acc--        goColumn !iy !ix !ky !acc-            | ky < kh   = case borderInterpolate interpol ih iy of-                            Left  iy' -> goLine iy (iy' * iw) ix ix ky 0 acc-                            Right val -> goLineConst iy ix ky 0 val acc-            | otherwise = acc--        goColumnSafe !linearIY !ix !ky !acc-            | ky < kh   = goLineSafe linearIY ix ix ky 0 acc-            | otherwise = acc--        goLine !iy !linearIY !ix0 !ix !ky !kx !acc-            | kx < kw   =-                let !val  = safeIndex linearIY ix-                    !acc' = kernel (ix2 ky kx) val acc-                in goLine iy linearIY ix0 (ix + 1) ky (kx + 1) acc'-            | otherwise = goColumn (iy + 1) ix0 (ky + 1) acc--        goLineSafe !linearIY !ix0 !ix !ky !kx !acc-            | kx < kw   =-                let !val  = img `linearIndex` (linearIY + ix)-                    !acc' = kernel (ix2 ky kx) val acc-                in goLineSafe linearIY ix0 (ix + 1) ky (kx + 1) acc'-            | otherwise = goColumnSafe (linearIY + iw) ix0 (ky + 1) acc--        goLineConst !iy !ix !ky !kx !val !acc-            | kx < kw   = let !acc' = kernel (ix2 ky kx) val acc-                          in goLineConst iy ix ky (kx + 1) val acc'-            | otherwise = goColumn (iy + 1) ix (ky + 1) acc--        safeIndex !linearIY !ix =-            case borderInterpolate interpol iw ix of-                Left  ix' -> img `linearIndex` (linearIY + ix')-                Right val -> val-    {-# INLINE apply #-}---- | Separable filters initialized with a given value.-instance (Image src, FromFunction res, SeparatelyFiltrable src res acc-        , src_p ~ ImagePixel src, res_p ~ FromFunctionPixel res-        , FromFunction      (SeparableFilterAccumulator src res acc)-        , FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc-        , Image             (SeparableFilterAccumulator src res acc)-        , ImagePixel        (SeparableFilterAccumulator src res acc) ~ acc)-        => Filterable src res (SeparableFilter src_p acc res_p)-            where-    apply !f !img =-        fst $! wrapper img f-      where-        wrapper :: (Image src, FromFunction res-            , FromFunction (SeparableFilterAccumulator src res acc)-            , FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc-            , Image             (SeparableFilterAccumulator src res acc)-            , ImagePixel        (SeparableFilterAccumulator src res acc) ~ acc)-            => src-            -> SeparableFilter (ImagePixel src) acc (FromFunctionPixel res)-            -> (res, SeparableFilterAccumulator src res acc)-        wrapper !src !(Filter ksize anchor kernel ini post interpol) =-            (res, tmp)-          where-            !size@(Z :. ih :. iw) = shape src--            !(Z :. kh  :. kw)  = ksize-            !(Z :. kcy :. kcx) = kernelAnchor anchor ksize--            !(SeparableKernel vert horiz) = kernel-            !(FilterFold acc0)            = ini--            !tmp = fromFunction size $ \(!(Z :. iy :. ix)) ->-                        let !iy0 = iy - kcy-                        in if iy0 >= 0 && iy0 + kh <= ih-                              then goColumnSafe iy0 ix 0 acc0-                              else goColumn     iy0 ix 0 acc0--            !res = fromFunction size $ \(!pt@(Z :. iy :. ix)) ->-                        let !ix0 = ix - kcx-                            !pix = src `index` pt-                        in post pix $! if ix0 >= 0 && ix0 + kw <= iw-                                            then goLineSafe (iy * iw) ix0 0 acc0-                                            else goLine     (iy * iw) ix0 0 acc0--            goColumn !iy !ix !ky !acc-                | ky < kh   =-                    let !val  = case borderInterpolate interpol ih iy of-                                    Left  iy'  -> src `index` ix2 iy' ix-                                    Right val' -> val'-                        !acc' = vert (ix1 ky) val acc-                    in goColumn (iy + 1) ix (ky + 1) acc'-                | otherwise = acc--            goColumnSafe !iy !ix !ky !acc-                | ky < kh   =-                    let !val  = src `index` ix2 iy ix-                        !acc' = vert (ix1 ky) val acc-                    in goColumnSafe (iy + 1) ix (ky + 1) acc'-                | otherwise = acc--            goLine !linearIY !ix !kx !acc-                | kx < kw   =-                    let !val =-                            case borderInterpolate interpol iw ix of-                                Left  ix'-> tmp `linearIndex` (linearIY + ix')-                                Right _  -> constLine-                        !acc' = horiz (ix1 kx) val acc-                    in goLine linearIY (ix + 1) (kx + 1) acc'-                | otherwise = acc--            goLineSafe !linearIY !ix !kx !acc-                | kx < kw   =-                    let !val = tmp `linearIndex` (linearIY + ix)-                        !acc' = horiz (ix1 kx) val acc-                    in goLineSafe linearIY (ix + 1) (kx + 1) acc'-                | otherwise = acc--            constLine | BorderConstant val <- interpol =-                        foldl' (\acc ky -> vert (ix1 ky) val acc) acc0 [0..kh-1]-                      | otherwise                      = undefined-        {-# INLINE wrapper #-}-    {-# INLINE apply #-}---- | Separable filters initialized using the first pixel of the kernel.-instance (Image src, FromFunction res, SeparatelyFiltrable src res src_p-        , src_p ~ ImagePixel src, res_p ~ FromFunctionPixel res-        , FromFunction      (SeparableFilterAccumulator src res src_p)-        , FromFunctionPixel (SeparableFilterAccumulator src res src_p) ~ src_p-        , Image             (SeparableFilterAccumulator src res src_p)-        , ImagePixel        (SeparableFilterAccumulator src res src_p) ~ src_p)-        => Filterable src res (SeparableFilter1 src_p res_p)-            where-    apply !f !img =-        fst $! wrapper img f-      where-        wrapper :: (Image src, FromFunction res, acc ~ ImagePixel src-            , FromFunction (SeparableFilterAccumulator src res acc)-            , FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc-            , Image             (SeparableFilterAccumulator src res acc)-            , ImagePixel        (SeparableFilterAccumulator src res acc) ~ acc)-            => src-            -> SeparableFilter1 (ImagePixel src) (FromFunctionPixel res)-            -> (res, SeparableFilterAccumulator src res acc)-        wrapper !src !(Filter ksize anchor kernel _ post interpol)-            | kh == 0 || kw == 0 =-                error "Using FilterFold1 with an empty kernel."-            | otherwise          =-                (res, tmp)-          where-            !size@(Z :. ih :. iw) = shape src--            !(Z :. kh  :. kw)  = ksize-            !(Z :. kcy :. kcx) = kernelAnchor anchor ksize--            !(SeparableKernel vert horiz) = kernel--            !tmp = fromFunction size $ \(!(Z :. iy :. ix)) ->-                        let !iy0 = iy - kcy-                        in if iy0 >= 0 && iy0 + kh <= ih-                              then goColumn1Safe iy0 ix-                              else goColumn1     iy0 ix--            !res = fromFunction size $ \(!pt@(Z :. iy :. ix)) ->-                        let !ix0 = ix - kcx-                            !pix = src `index` pt-                        in post pix $! if ix0 >= 0 && ix0 + kw <= iw-                                            then goLine1Safe (iy * iw) ix0-                                            else goLine1     (iy * iw) ix0--            goColumn1 !iy !ix =-                case borderInterpolate interpol ih iy of-                    Left  iy' ->-                        let !acc = src `index` ix2 iy' ix-                        in goColumn (iy + 1) ix 1 acc-                    Right val ->-                        goColumn (iy + 1) ix 1 val--            goColumn1Safe !iy !ix =-                let !linearIY = iy * iw-                    !acc      = src `linearIndex` (linearIY + ix)-                in goColumnSafe (linearIY + iw) ix 1 acc--            goColumn !iy !ix !ky !acc-                | ky < kh   =-                    let !val  = case borderInterpolate interpol ih iy of-                                    Left  iy'  -> src `index` ix2 iy' ix-                                    Right val' -> val'-                        !acc' = vert (ix1 ky) val acc-                    in goColumn (iy + 1) ix (ky + 1) acc'-                | otherwise = acc--            goColumnSafe !linearIY !ix !ky !acc-                | ky < kh   =-                    let !val  = src `linearIndex` (linearIY + ix)-                        !acc' = vert (ix1 ky) val acc-                    in goColumnSafe (linearIY + iw) ix (ky + 1) acc'-                | otherwise = acc--            goLine1 !linearIY !ix =-                let !acc =-                        case borderInterpolate interpol iw ix of-                            Left  ix' -> tmp `linearIndex` (linearIY + ix')-                            Right _   -> columnConst-                in goLine linearIY (ix + 1) 1 acc--            goLine1Safe !linearIY !ix =-                let !linearIX = linearIY + ix-                    !acc      = tmp `linearIndex` linearIX-                in goLineSafe (linearIX + 1) 1 acc--            goLine !linearIY !ix !kx !acc-                | kx < kw   =-                    let !val =-                            case borderInterpolate interpol iw ix of-                                Left  ix'-> tmp `linearIndex` (linearIY + ix')-                                Right _  -> columnConst-                        !acc' = horiz (ix1 kx) val acc-                    in goLine linearIY (ix + 1) (kx + 1) acc'-                | otherwise = acc--            goLineSafe !linearIX !kx !acc-                | kx < kw   =-                    let !val = tmp `linearIndex` linearIX-                        !acc' = horiz (ix1 kx) val acc-                    in goLineSafe (linearIX + 1) (kx + 1) acc'-                | otherwise = acc--            columnConst-                | BorderConstant val <- interpol = goColumnConst 1 val val-                | otherwise                      = undefined--            goColumnConst !ky !val !acc-                | ky < kh   = goColumnConst (ky + 1) val (vert (ix1 ky) acc val)-                | otherwise = acc-        {-# INLINE wrapper #-}-    {-# INLINE apply #-}---- Functions ----------------------------------------------------------------------- | Given a method to compute the kernel anchor and the size of the kernel,--- returns the anchor of the kernel as coordinates.-kernelAnchor :: KernelAnchor -> Size -> DIM2-kernelAnchor (KernelAnchor ix)    _               = ix-kernelAnchor (KernelAnchorCenter) (Z :. kh :. kw) = ix2 (round $ (kh - 1) % 2)-                                                        (round $ (kw - 1) % 2)+import Vision.Primitive (Size) --- | Given a method of interpolation, the number of pixel in the dimension and--- an index in this dimension, returns either the index of the interpolated--- pixel or a constant value.-borderInterpolate :: BorderInterpolate a-                  -> Int -- ^ The size of the dimension.-                  -> Int -- ^ The index in the dimension.-                  -> Either Int a-borderInterpolate !interpol !len !ix-    | word ix < word len = Left ix-    | otherwise          =-        case interpol of-            BorderReplicate | ix < 0    -> Left 0-                            | otherwise -> Left $! len - 1-            BorderReflect               -> Left $! goReflect ix-            BorderWrap                  -> Left $! ix `mod` len-            BorderConstant i            -> Right i-  where-    goReflect !ix' | ix' < 0    = goReflect (-ix' - 1)-                   | ix' >= len = goReflect ((len - 1) - (ix' - len))-                   | otherwise  = ix'-{-# INLINE borderInterpolate #-}+import qualified Vision.Image.Filter.Internal as Internal  -- Morphological operators ----------------------------------------------------- -dilate :: Ord src => Int -> SeparableFilter1 src src-dilate radius =-    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel kernel kernel)-           FilterFold1 (\_ acc -> acc) BorderReplicate-  where-    !size = radius * 2 + 1--    kernel _ = max-{-# INLINE dilate #-}+dilate, erode :: ( Image src, Ord (ImagePixel src)+                 , FromFunction res, FromFunctionPixel res ~ ImagePixel src+                 , SeparatelyFiltrable src res (ImagePixel src))+       => Int           -- ^ Kernel radius.+       -> src+       -> res -erode :: Ord src => Int -> SeparableFilter1 src src-erode radius =-    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel kernel kernel)-           FilterFold1 (\_ acc -> acc) BorderReplicate-  where-    !size = radius * 2 + 1+dilate radius img = Internal.dilate radius `Internal.apply` img+{-# INLINABLE dilate #-} -    kernel _ = min-{-# INLINE erode #-}+erode  radius img = Internal.erode radius `Internal.apply` img+{-# INLINABLE erode #-}  -- Blur ------------------------------------------------------------------------  -- | Blurs the image by averaging the pixel inside the kernel. ----- Considers using a type for 'acc' with--- @maxBound acc >= maxBound src * (kernel size)²@.-blur :: (Integral src, Integral acc, Num res)-     => Int -- ^ Blur radius.-     -> SeparableFilter src acc res-blur radius =-    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel vert horiz)-           (FilterFold 0) post BorderReplicate-  where-    !size  = radius * 2 + 1-    !nPixs = fromIntegral $ square size--    vert  _ !val  !acc = acc + fromIntegral val--    horiz _ !acc' !acc = acc + acc'--    post _ acc = fromIntegral $ acc `div` nPixs-{-# INLINE blur #-}+-- Uses an 'Int32' as accumulator during the averaging operation.+blur :: ( Image src, Integral (ImagePixel src)+        , FromFunction res, Num (FromFunctionPixel res)+        , SeparatelyFiltrable src res Int32)+       => Int           -- ^ Blur radius.+       -> src+       -> res+blur radius img =+    let filt :: (Integral src, Num res) => Internal.Blur src Int32 res+        filt = Internal.blur radius+    in filt `Internal.apply` img+{-# INLINABLE blur #-}  -- | Blurs the image by averaging the pixel inside the kernel using a Gaussian -- function. -- -- See <http://en.wikipedia.org/wiki/Gaussian_blur>-gaussianBlur :: (Integral src, Floating acc, RealFrac acc, Storable acc-               , Integral res)-             => Int -- ^ Blur radius.+gaussianBlur :: ( Image src, Integral (ImagePixel src)+                , FromFunction res, Integral (FromFunctionPixel res)+                , Floating acc, RealFrac acc, Storable acc+                , SeparatelyFiltrable src res acc)+             => Int     -- ^ Blur radius.              -> Maybe acc              -- ^ Sigma value of the Gaussian function. If not given, will be              -- automatically computed from the radius so that the kernel              -- fits 3σ of the distribution.-             -> SeparableFilter src acc res-gaussianBlur !radius !mSig =-    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel vert horiz)-           (FilterFold 0) (\_ !acc -> round acc) BorderReplicate-  where-    !size = radius * 2 + 1--    -- If σ is not provided, tries to fit 3σ in the kernel.-    !sig = case mSig of Just s  -> s-                        Nothing -> (0.5 + fromIntegral radius) / 3--    vert  !(Z :. y) !val !acc = let !coeff = kernelVec V.! y-                                in acc + fromIntegral val * coeff--    horiz !(Z :. x) !val !acc = let !coeff = kernelVec V.! x-                                in acc + val * coeff--    !kernelVec =-        -- Creates a vector of Gaussian values and normalizes it so its sum-        -- equals 1.-        let !unormalized = V.generate size $ \x ->-                                gaussian $! fromIntegral $! abs $! x - radius-            !kernelSum   = V.sum unormalized-        in V.map (/ kernelSum) unormalized--    gaussian !x = invSigSqrt2Pi * exp (inv2xSig2 * square x)--    -- Pre-computed terms of the Gaussian function.-    !invSigSqrt2Pi = 1 / (sig * sqrt (2 * pi))-    !inv2xSig2     = -1 / (2 * square sig)-{-# INLINE gaussianBlur #-}+             -> src+             -> res+gaussianBlur radius mSig img =+    Internal.gaussianBlur radius mSig `Internal.apply` img+{-# INLINABLE gaussianBlur #-}  -- Derivation ------------------------------------------------------------------ -data Derivative = DerivativeX | DerivativeY- -- | Estimates the first derivative using the Scharr's 3x3 kernel. -- -- Convolves the following kernel for the X derivative:@@ -630,61 +112,46 @@ --   3  10   3 -- @ ----- Considers using a signed integer type for 'res' with--- @maxBound res >= 16 * maxBound src@.-scharr :: (Integral src, Integral res)-       => Derivative -> SeparableFilter src res res-scharr der =-    let !kernel =-            case der of-                DerivativeX -> SeparableKernel kernel1 kernel2-                DerivativeY -> SeparableKernel kernel2 kernel1-    in Filter (ix2 3 3) KernelAnchorCenter kernel (FilterFold 0) (\_ acc -> acc)-              BorderReplicate-  where-    kernel1 !(Z :. 1)  !val !acc = acc + 10 * fromIntegral val-    kernel1 !(Z :. _)  !val !acc = acc + 3  * fromIntegral val--    kernel2 !(Z :.  0) !val !acc = acc - fromIntegral val-    kernel2 !(Z :.  1) !_   !acc = acc-    kernel2 !(Z :. ~2) !val !acc = acc + fromIntegral val-{-# INLINE scharr #-}+-- Uses an 'Int32' as accumulator during kernel application.+scharr :: ( Image src, Integral (ImagePixel src)+          , FromFunction res, Integral (FromFunctionPixel res)+          , Storable (FromFunctionPixel res)+          , SeparatelyFiltrable src res (FromFunctionPixel res))+       => DerivativeType -> src -> res+scharr der img = Internal.scharr der `Internal.apply` img+{-# INLINABLE scharr #-}  -- | Estimates the first derivative using a Sobel's kernel. -- -- Prefer 'scharr' when radius equals @1@ as Scharr's kernel is more accurate -- and is implemented faster. ----- Considers using a signed integer type for 'res' which is significantly larger--- than 'src', especially for large kernels.-sobel :: (Integral src, Integral res, Storable res)-      => Int        -- ^ Kernel radius.-      -> Derivative-      -> SeparableFilter src res res-sobel radius der =-    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel vert horiz)-           (FilterFold 0) (\_ acc -> acc) BorderReplicate-  where-    !size = radius * 2 + 1--    vert  !(Z :. x) !val !acc = let !coeff = vec1 V.! x-                                in acc + fromIntegral val * coeff--    horiz !(Z :. x) !val !acc = let !coeff = vec2 V.! x-                                in acc + fromIntegral val * coeff--    !radius' = fromIntegral radius--    (!vec1, !vec2) = case der of DerivativeX -> (vec1', vec2')-                                 DerivativeY -> (vec2', vec1')--    !vec1' = let pows = [ 2^i | i <- [0..radius'] ]-             in V.fromList $ pows ++ (tail (reverse pows))-    !vec2' = V.fromList $ map negate [1..radius'] ++ [0] ++ [1..radius']-{-# INLINE sobel #-}+-- Uses an 'Int32' as accumulator during kernel application.+sobel :: ( Image src, Integral (ImagePixel src)+          , FromFunction res, Integral (FromFunctionPixel res)+          , Storable (FromFunctionPixel res)+          , SeparatelyFiltrable src res (FromFunctionPixel res))+      => Int            -- ^ Kernel radius.+      -> DerivativeType+      -> src+      -> res+sobel radius der img = Internal.sobel radius der `Internal.apply` img+{-# INLINABLE sobel #-} -square :: Num a => a -> a-square a = a * a+-- Others ---------------------------------------------------------------------- -word :: Integral a => a -> Word-word = fromIntegral+-- | Computes the average of a kernel of the given size.+--+-- This is similar to 'blur' but with a rectangular kernel and a 'Fractional'+-- result.+--+-- Uses an 'Int32' as accumulator during the averaging operation.+mean :: ( Image src, Integral (ImagePixel src)+        , FromFunction res, Fractional (FromFunctionPixel res)+        , SeparatelyFiltrable src res Int32)+     => Size -> src -> res+mean size img =+    let filt :: (Integral src, Fractional res) => Internal.Mean src Int32 res+        filt = Internal.mean size+    in filt `Internal.apply` img+{-# INLINABLE mean #-}

@@ -0,0 +1,758 @@+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , FlexibleInstances+           , GADTs+           , MultiParamTypeClasses+           , TypeFamilies+           , TupleSections+           , ScopedTypeVariables #-}++-- | Provides high level functions to define and apply filters on images.+--+-- Filters are operations on images on which the surrounding of each processed+-- pixel is considered according to a kernel.+--+-- Please use 'Vision.Image.Filter' if you only want to apply filter to images.+--+-- To apply a filter to an image, use the 'apply' method:+--+-- @+-- let -- Creates a filter which will blur the image. Uses a 'Double' as+--     -- accumulator of the Gaussian kernel.+--     filter :: 'Blur' GreyPixel Double GreyPixel+--     filter = 'gaussianBlur' 2 Nothing+-- in 'apply' filter img :: Grey+-- @+--+-- The @radius@ argument of some filters is used to determine the kernel size.+-- A radius as of 1 means a kernel of size 3, 2 a kernel of size 5 and so on.+--+-- The @acc@ type argument of some filters defines the type which will be used+-- to store the accumulated value of the kernel (e.g. by setting @acc@ to+-- 'Double' in the computation of a Gaussian blur, the kernel average will be+-- computed using a 'Double').+module Vision.Image.Filter.Internal (+    -- * Types+      Filterable (..), Filter (..)+    , BoxFilter, BoxFilter1, SeparableFilter, SeparableFilter1+    , KernelAnchor (..)+    , Kernel (..)+    , SeparableKernel (..), SeparatelyFiltrable (..)+    , FilterFold (..), FilterFold1 (..)+    , BorderInterpolate (..)+    -- * Functions+    , kernelAnchor, borderInterpolate+    -- * Filters+    -- ** Morphological operators+    , Morphological, dilate, erode+    -- ** Blur+    , Blur, blur, gaussianBlur+    -- ** Derivation+    , Derivative, DerivativeType (..), scharr, sobel+    -- ** Others+    , Mean, mean+    ) where++import Data.List+import Data.Ratio+import Data.Word+import Foreign.Storable (Storable)++import qualified Data.Vector.Storable as V++import Vision.Image.Class (MaskedImage (..), Image (..), FromFunction (..), (!))+import Vision.Image.Type (Manifest, Delayed)+import Vision.Primitive (Z (..), (:.) (..), DIM1, Point, Size, ix1, ix2)++-- Types -----------------------------------------------------------------------++-- | Provides an implementation to execute a type of filter.+--+-- 'src' is the original image, 'res' the resulting image and 'f' the filter.+class Filterable src res f where+    -- | Applies the given filter on the given image.+    apply :: f -> src -> res++data Filter src kernel init fold acc res = Filter {+      fKernelSize   :: !Size+    , fKernelCenter :: !KernelAnchor+    -- | See 'Kernel' and 'SeparableKernel'.+    , fKernel       :: !kernel+    -- | Computes a constant value for each pixel before applying the kernel.+    --+    -- This value will be passed to 'fKernel' functions and to the 'fPost'+    -- function.+    -- For most filters, @fInit@ will be @\_ _ -> ()@.+    , fInit         :: !(Point -> src -> init)+    -- | Defines how the accumulated value is initialized.+    --+    -- See 'FilterFold' and 'FilterFold1'.+    , fFold         :: !fold+    -- | This function will be executed after the iteration of the kernel on a+    -- given point.+    --+    -- Can be used to normalize the accumulated value, for example.+    , fPost         :: !(Point -> src -> init -> acc -> res)+    , fInterpol     :: !(BorderInterpolate src)+    }++-- | 2D filters which are initialized with a value.+type BoxFilter src init acc res       = Filter src (Kernel src init acc) init+                                               (FilterFold acc) acc res++-- | 2D filters which are not initialized with a value.+type BoxFilter1 src init res          = Filter src (Kernel src init src) init+                                               FilterFold1 src res++-- | Separable 2D filters which are initialized with a value.+type SeparableFilter src init acc res = Filter src+                                               (SeparableKernel src init acc)+                                               init (FilterFold acc) acc res++-- | Separable 2D filters which are not initialized with a value.+type SeparableFilter1 src init res    = Filter src+                                               (SeparableKernel src init src)+                                               init FilterFold1 src res++-- | Defines how the center of the kernel will be determined.+data KernelAnchor = KernelAnchor !Point | KernelAnchorCenter++-- | A simple 2D kernel.+--+-- The kernel function accepts the coordinates in the kernel, the value of the+-- pixel at these coordinates ('src'), the current accumulated value and returns+-- a new accumulated value.+--+-- Non-separable filters computational complexity grows quadratically according+-- to the size of the sides of the kernel.+newtype Kernel src init acc = Kernel (init -> Point -> src -> acc -> acc)++-- | Some kernels can be factorized in two uni-dimensional kernels (horizontal+-- and vertical).+--+-- Separable filters computational complexity grows linearly according to the+-- size of the sides of the kernel.+--+-- See <http://http://en.wikipedia.org/wiki/Separable_filter>.+data SeparableKernel src init acc = SeparableKernel {+    -- | Vertical (column) kernel.+      skVertical   :: !(init -> DIM1 -> src -> acc -> acc)+    -- | Horizontal (row) kernel.+    , skHorizontal :: !(init -> DIM1 -> acc -> acc -> acc)+    }++-- | Used to determine the type of the accumulator image used when computing+-- separable filters.+--+-- 'src' and 'res' are respectively the source and the result image types while+-- 'acc' is the pixel type of the accumulator.+class ( Image (SeparableFilterAccumulator src res acc)+      , ImagePixel (SeparableFilterAccumulator src res acc) ~ acc+      , FromFunction (SeparableFilterAccumulator src res acc)+      , FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc)+      => SeparatelyFiltrable src res acc where+    type SeparableFilterAccumulator src res acc++instance Storable acc => SeparatelyFiltrable src (Manifest p) acc where+    type SeparableFilterAccumulator src (Manifest p) acc = Manifest acc++instance Storable acc => SeparatelyFiltrable src (Delayed p) acc where+    type SeparableFilterAccumulator src (Delayed p) acc = Delayed acc++-- | Uses the result of the provided function as the initial value of the+-- kernel's accumulator, depending on the center coordinates in the image.+--+-- For most filters, the function will always return the same value (i.e.+-- defined as @const 0@), but this kind of initialization could be required for+-- some filters.+data FilterFold acc = FilterFold (Point -> acc)++-- | Uses the first pixel in the kernel as initial value. The kernel must not be+-- empty and the accumulator type must be the same as the source pixel type.+--+-- This kind of initialization is needed by morphological filters.+data FilterFold1 = FilterFold1++-- | Defines how image boundaries are extrapolated by the algorithms.+--+-- '|' characters in examples are image borders.+data BorderInterpolate a =+    -- | Replicates the first and last pixels of the image.+    --+    -- > aaaaaa|abcdefgh|hhhhhhh+      BorderReplicate+    -- | Reflects the border of the image.+    --+    -- > fedcba|abcdefgh|hgfedcb+    | BorderReflect+    -- | Considers that the last pixel of the image is before the first one.+    --+    -- > cdefgh|abcdefgh|abcdefg+    | BorderWrap+    -- | Assigns a constant value to out of image pixels.+    --+    -- > iiiiii|abcdefgh|iiiiiii  with some specified 'i'+    | BorderConstant !a++-- Instances -------------------------------------------------------------------++-- Following implementations share a lot of similar processing. However, GHC+-- fails to specialise and optimise correctly when goXXX functions are top-level+-- functions, even with static argument transformations.++-- | Box filters initialized with a given value.+instance (Image src, FromFunction res, src_pix ~ ImagePixel src+        , res_pix ~ FromFunctionPixel res)+        => Filterable src res (BoxFilter src_pix init acc res_pix) where+    apply !(Filter ksize anchor (Kernel kernel) initF fold post interpol) !img =+        let !(FilterFold fAcc)  = fold+        in fromFunction size $ \(!pt@(Z :. iy :. ix)) ->+            let pix   = img ! pt+                !ini  = initF pt pix+                !acc  = fAcc pt+                !iy0  = iy - kcy+                !ix0  = ix - kcx+                !safe =    iy0 >= 0 && iy0 + kh <= ih+                        && ix0 >= 0 && ix0 + kw <= iw+            in post pt pix ini $!+                    if safe then goColumnSafe ini (iy0 * iw) ix0 0 acc+                            else goColumn     ini iy0        ix0 0 acc+      where+        !size@(Z :. ih :. iw) = shape img++        !(Z :. kh  :. kw)  = ksize+        !(Z :. kcy :. kcx) = kernelAnchor anchor ksize++        goColumn !ini !iy !ix !ky !acc+            | ky < kh   = case borderInterpolate interpol ih iy of+                            Left  iy' -> goLine ini iy (iy' * iw) ix ix ky 0 acc+                            Right val -> goLineConst ini iy ix ky 0 val acc+            | otherwise = acc++        goColumnSafe !ini !linearIY !ix !ky !acc+            | ky < kh   = goLineSafe ini linearIY ix ix ky 0 acc+            | otherwise = acc++        goLine !ini !iy !linearIY !ix0 !ix !ky !kx !acc+            | kx < kw   =+                let !val  = case borderInterpolate interpol iw ix of+                                Left  ix'  -> img `linearIndex` (linearIY + ix')+                                Right val' -> val'+                    !acc' = kernel ini (ix2 ky kx) val acc+                in goLine ini iy linearIY ix0 (ix + 1) ky (kx + 1) acc'+            | otherwise = goColumn ini (iy + 1) ix0 (ky + 1) acc++        goLineSafe !ini !linearIY !ix0 !ix !ky !kx !acc+            | kx < kw   =+                let !val  = img `linearIndex` (linearIY + ix)+                    !acc' = kernel ini (ix2 ky kx) val acc+                in goLineSafe ini linearIY ix0 (ix + 1) ky (kx + 1) acc'+            | otherwise = goColumnSafe ini (linearIY + iw) ix0 (ky + 1) acc++        goLineConst !ini !iy !ix !ky !kx !val !acc+            | kx < kw   = let !acc' = kernel ini (ix2 ky kx) val acc+                          in goLineConst ini iy ix ky (kx + 1) val acc'+            | otherwise = goColumn ini (iy + 1) ix (ky + 1) acc+    {-# INLINE apply #-}++-- | Box filters initialized using the first pixel of the kernel.+instance (Image src, FromFunction res, src_pix ~ ImagePixel src+        , res_pix ~ FromFunctionPixel res)+        => Filterable src res (BoxFilter1 src_pix init res_pix) where+    apply !(Filter ksize anchor (Kernel kernel) initF _ post interpol) !img+        | kh == 0 || kw == 0 =+            error "Using FilterFold1 with an empty kernel."+        | otherwise          =+            fromFunction size $ \(!pt@(Z :. iy :. ix)) ->+                let pix   = img ! pt+                    !ini  = initF pt pix+                    !iy0  = iy - kcy+                    !ix0  = ix - kcx+                    !safe =    iy0 >= 0 && iy0 + kh <= ih+                            && ix0 >= 0 && ix0 + kw <= iw+                in post pt pix ini $! if safe then goColumn1Safe ini iy0 ix0+                                              else goColumn1     ini iy0 ix0+      where+        !size@(Z :. ih :. iw) = shape img++        !(Z :. kh  :. kw)  = ksize+        !(Z :. kcy :. kcx) = kernelAnchor anchor ksize++        goColumn1 !ini !iy !ix =+            case borderInterpolate interpol ih iy of+                Left  iy' ->+                    let !linearIY = iy' * iw+                        !acc      = safeIndex linearIY ix+                    in goLine ini iy linearIY ix (ix + 1) 0 1 acc+                Right val -> goLineConst ini iy ix 0 1 val val++        goColumn1Safe !ini !iy !ix =+            let !linearIY = iy * iw+                !acc      = img `linearIndex` (linearIY + ix)+            in goLineSafe ini linearIY ix (ix + 1) 0 1 acc++        goColumn !ini !iy !ix !ky !acc+            | ky < kh   = case borderInterpolate interpol ih iy of+                            Left  iy' -> goLine ini iy (iy' * iw) ix ix ky 0 acc+                            Right val -> goLineConst ini iy ix ky 0 val acc+            | otherwise = acc++        goColumnSafe !ini !linearIY !ix !ky !acc+            | ky < kh   = goLineSafe ini linearIY ix ix ky 0 acc+            | otherwise = acc++        goLine !ini !iy !linearIY !ix0 !ix !ky !kx !acc+            | kx < kw   =+                let !val  = safeIndex linearIY ix+                    !acc' = kernel ini (ix2 ky kx) val acc+                in goLine ini iy linearIY ix0 (ix + 1) ky (kx + 1) acc'+            | otherwise = goColumn ini (iy + 1) ix0 (ky + 1) acc++        goLineSafe !ini !linearIY !ix0 !ix !ky !kx !acc+            | kx < kw   =+                let !val  = img `linearIndex` (linearIY + ix)+                    !acc' = kernel ini (ix2 ky kx) val acc+                in goLineSafe ini linearIY ix0 (ix + 1) ky (kx + 1) acc'+            | otherwise = goColumnSafe ini (linearIY + iw) ix0 (ky + 1) acc++        goLineConst !ini !iy !ix !ky !kx !val !acc+            | kx < kw   = let !acc' = kernel ini (ix2 ky kx) val acc+                          in goLineConst ini iy ix ky (kx + 1) val acc'+            | otherwise = goColumn ini (iy + 1) ix (ky + 1) acc++        safeIndex !linearIY !ix =+            case borderInterpolate interpol iw ix of+                Left  ix' -> img `linearIndex` (linearIY + ix')+                Right val -> val+    {-# INLINE apply #-}++-- | Separable filters initialized with a given value.+instance ( Image src, FromFunction res+         , src_pix ~ ImagePixel src+         , res_pix ~ FromFunctionPixel res+         , SeparatelyFiltrable src res acc)+        => Filterable src res (SeparableFilter src_pix init acc res_pix)+            where+    apply !f !img =+        fst $! wrapper img f+      where+        wrapper :: (Image src, FromFunction res)+            => src+            -> SeparableFilter (ImagePixel src) init acc (FromFunctionPixel res)+            -> (res, SeparableFilterAccumulator src res acc)+        wrapper !src !(Filter ksize anchor kernel initF fold post interpol) =+            (res, tmp)+          where+            !size@(Z :. ih :. iw) = shape src++            !(Z :. kh  :. kw)  = ksize+            !(Z :. kcy :. kcx) = kernelAnchor anchor ksize++            !(SeparableKernel vert horiz) = kernel+            !(FilterFold fAcc)            = fold++            !tmp = fromFunction size $ \(!pt@(Z :. iy :. ix)) ->+                        let pix   = src ! pt+                            !ini  = initF pt pix+                            !acc0 = fAcc pt+                            !iy0  = iy - kcy+                        in if iy0 >= 0 && iy0 + kh <= ih+                              then goColumnSafe ini iy0 ix 0 acc0+                              else goColumn     ini iy0 ix 0 acc0++            !res = fromFunction size $ \(!pt@(Z :. iy :. ix)) ->+                        let pix   = src ! pt+                            !ini  = initF pt pix+                            !acc0 = fAcc pt+                            !ix0  = ix - kcx+                        in post pt pix ini $!+                                if ix0 >= 0 && ix0 + kw <= iw+                                    then goLineSafe ini (iy * iw) ix0 0 acc0+                                    else goLine     ini acc0 (iy * iw) ix0 0+                                                    acc0++            goColumn !ini !iy !ix !ky !acc+                | ky < kh   =+                    let !val  = case borderInterpolate interpol ih iy of+                                    Left  iy'  -> src ! ix2 iy' ix+                                    Right val' -> val'+                        !acc' = vert ini (ix1 ky) val acc+                    in goColumn ini (iy + 1) ix (ky + 1) acc'+                | otherwise = acc++            goColumnSafe !ini !iy !ix !ky !acc+                | ky < kh   =+                    let !val  = src ! ix2 iy ix+                        !acc' = vert ini (ix1 ky) val acc+                    in goColumnSafe ini (iy + 1) ix (ky + 1) acc'+                | otherwise = acc++            goLine !ini !acc0 !linearIY !ix !kx !acc+                | kx < kw   =+                    let !val =+                            case borderInterpolate interpol iw ix of+                                Left  ix'  -> tmp `linearIndex` (linearIY + ix')+                                Right val' -> constCol ini acc0 val'+                        !acc' = horiz ini (ix1 kx) val acc+                    in goLine ini acc0 linearIY (ix + 1) (kx + 1) acc'+                | otherwise = acc++            goLineSafe !ini !linearIY !ix !kx !acc+                | kx < kw   =+                    let !val = tmp `linearIndex` (linearIY + ix)+                        !acc' = horiz ini (ix1 kx) val acc+                    in goLineSafe ini linearIY (ix + 1) (kx + 1) acc'+                | otherwise = acc++            -- Computes the value of an out of image column when the+            -- interpolation method is BorderConstant.+            constCol !ini !acc0 !constVal =+                foldl' (\acc ky -> vert ini (ix1 ky) constVal acc) acc0+                       [0..kh-1]+        {-# INLINE wrapper #-}+    {-# INLINE apply #-}++-- | Separable filters initialized using the first pixel of the kernel.+instance ( Image src, FromFunction res+         , src_pix ~ ImagePixel src+         , res_pix ~ FromFunctionPixel res+         , SeparatelyFiltrable src res src_pix)+        => Filterable src res (SeparableFilter1 src_pix init res_pix)+            where+    apply !f !img =+        fst $! wrapper img f+      where+        wrapper :: (Image src, FromFunction res, acc ~ ImagePixel src+            , FromFunction (SeparableFilterAccumulator src res acc)+            , FromFunctionPixel (SeparableFilterAccumulator src res acc) ~ acc+            , Image             (SeparableFilterAccumulator src res acc)+            , ImagePixel        (SeparableFilterAccumulator src res acc) ~ acc)+            => src+            -> SeparableFilter1 (ImagePixel src) init (FromFunctionPixel res)+            -> (res, SeparableFilterAccumulator src res acc)+        wrapper !src !(Filter ksize anchor kernel initF _ post interpol)+            | kh == 0 || kw == 0 =+                error "Using FilterFold1 with an empty kernel."+            | otherwise          =+                (res, tmp)+          where+            !size@(Z :. ih :. iw) = shape src++            !(Z :. kh  :. kw)  = ksize+            !(Z :. kcy :. kcx) = kernelAnchor anchor ksize++            !(SeparableKernel vert horiz) = kernel++            !tmp = fromFunction size $ \(!pt@(Z :. iy :. ix)) ->+                        let pix  = src ! pt+                            !ini = initF pt pix+                            !iy0 = iy - kcy+                        in if iy0 >= 0 && iy0 + kh <= ih+                              then goColumn1Safe ini iy0 ix+                              else goColumn1     ini iy0 ix++            !res = fromFunction size $ \(!pt@(Z :. iy :. ix)) ->+                        let pix  = src ! pt+                            !ini = initF pt pix+                            !ix0 = ix - kcx+                        in post pt pix ini $!+                                if ix0 >= 0 && ix0 + kw <= iw+                                    then goLine1Safe ini (iy * iw) ix0+                                    else goLine1     ini (iy * iw) ix0++            goColumn1 !ini !iy !ix =+                case borderInterpolate interpol ih iy of+                    Left  iy' ->+                        let !acc = src ! ix2 iy' ix+                        in goColumn ini (iy + 1) ix 1 acc+                    Right val ->+                        goColumn ini (iy + 1) ix 1 val++            goColumn1Safe !ini !iy !ix =+                let !linearIY = iy * iw+                    !acc      = src `linearIndex` (linearIY + ix)+                in goColumnSafe ini (linearIY + iw) ix 1 acc++            goColumn !ini !iy !ix !ky !acc+                | ky < kh   =+                    let !val  = case borderInterpolate interpol ih iy of+                                    Left  iy'  -> src ! ix2 iy' ix+                                    Right val' -> val'+                        !acc' = vert ini (ix1 ky) val acc+                    in goColumn ini (iy + 1) ix (ky + 1) acc'+                | otherwise = acc++            goColumnSafe !ini !linearIY !ix !ky !acc+                | ky < kh   =+                    let !val  = src `linearIndex` (linearIY + ix)+                        !acc' = vert ini (ix1 ky) val acc+                    in goColumnSafe ini (linearIY + iw) ix (ky + 1) acc'+                | otherwise = acc++            goLine1 !ini !linearIY !ix =+                let !acc =+                        case borderInterpolate interpol iw ix of+                            Left  ix' -> tmp `linearIndex` (linearIY + ix')+                            Right val -> columnConst ini val+                in goLine ini linearIY (ix + 1) 1 acc++            goLine1Safe !ini !linearIY !ix =+                let !linearIX = linearIY + ix+                    !acc      = tmp `linearIndex` linearIX+                in goLineSafe ini (linearIX + 1) 1 acc++            goLine !ini !linearIY !ix !kx !acc+                | kx < kw   =+                    let !val =+                            case borderInterpolate interpol iw ix of+                                Left  ix'  -> tmp `linearIndex` (linearIY + ix')+                                Right val' -> columnConst ini val'+                        !acc' = horiz ini (ix1 kx) val acc+                    in goLine ini linearIY (ix + 1) (kx + 1) acc'+                | otherwise = acc++            goLineSafe !ini !linearIX !kx !acc+                | kx < kw   =+                    let !val = tmp `linearIndex` linearIX+                        !acc' = horiz ini (ix1 kx) val acc+                    in goLineSafe ini (linearIX + 1) (kx + 1) acc'+                | otherwise = acc++            columnConst !ini !constVal = goColumnConst ini 1 constVal constVal++            goColumnConst !ini !ky !constVal !acc+                | ky < kh   = goColumnConst ini (ky + 1) constVal+                                            (vert ini (ix1 ky) acc constVal)+                | otherwise = acc+        {-# INLINE wrapper #-}+    {-# INLINE apply #-}++-- Functions -------------------------------------------------------------------++-- | Given a method to compute the kernel anchor and the size of the kernel,+-- returns the anchor of the kernel as coordinates.+kernelAnchor :: KernelAnchor -> Size -> Point+kernelAnchor (KernelAnchor ix)    _               = ix+kernelAnchor (KernelAnchorCenter) (Z :. kh :. kw) = ix2 (round $ (kh - 1) % 2)+                                                        (round $ (kw - 1) % 2)++-- | Given a method of interpolation, the number of pixel in the dimension and+-- an index in this dimension, returns either the index of the interpolated+-- pixel or a constant value.+borderInterpolate :: BorderInterpolate a+                  -> Int -- ^ The size of the dimension.+                  -> Int -- ^ The index in the dimension.+                  -> Either Int a+borderInterpolate !interpol !len !ix+    | word ix < word len = Left ix+    | otherwise          =+        case interpol of+            BorderReplicate | ix < 0    -> Left 0+                            | otherwise -> Left $! len - 1+            BorderReflect               -> Left $! goReflect ix+            BorderWrap                  -> Left $! ix `mod` len+            BorderConstant i            -> Right i+  where+    goReflect !ix' | ix' < 0    = goReflect (-ix' - 1)+                   | ix' >= len = goReflect ((len - 1) - (ix' - len))+                   | otherwise  = ix'+{-# INLINE borderInterpolate #-}++-- Morphological operators -----------------------------------------------------++type Morphological pix = SeparableFilter1 pix () pix++dilate :: Ord pix => Int -> Morphological pix+dilate radius =+    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel kernel kernel)+           (\_ _ -> ()) FilterFold1 (\_ _ _ !acc -> acc) BorderReplicate+  where+    !size = radius * 2 + 1++    kernel _ _ = max+{-# INLINE dilate #-}++erode :: Ord pix => Int -> Morphological pix+erode radius =+    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel kernel kernel)+           (\_ _ -> ()) FilterFold1 (\_ _ _ !acc -> acc) BorderReplicate+  where+    !size = radius * 2 + 1++    kernel _ _ = min+{-# INLINE erode #-}++-- Blur ------------------------------------------------------------------------++type Blur src acc res = SeparableFilter src () acc res++-- | Blurs the image by averaging the pixel inside the kernel.+--+-- Considers using a type for 'acc' with+-- @maxBound acc >= maxBound src * (kernel size)²@.+blur :: (Integral src, Integral acc, Num res)+     => Int -- ^ Blur radius.+     -> Blur src acc res+blur radius =+    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel vert horiz)+           (\_ _ -> ()) (FilterFold (const 0)) post BorderReplicate+  where+    !size  = radius * 2 + 1+    !nPixs = fromIntegral $ square size++    vert  _ _ !val  !acc = acc + fromIntegral val+    horiz _ _ !acc' !acc = acc + acc'++    post _ _ _ !acc = fromIntegral $ acc `div` nPixs+{-# INLINE blur #-}++-- | Blurs the image by averaging the pixel inside the kernel using a Gaussian+-- function.+--+-- See <http://en.wikipedia.org/wiki/Gaussian_blur>+gaussianBlur :: (Integral src, Floating acc, RealFrac acc, Storable acc+               , Integral res)+             => Int -- ^ Blur radius.+             -> Maybe acc+             -- ^ Sigma value of the Gaussian function. If not given, will be+             -- automatically computed from the radius so that the kernel+             -- fits 3σ of the distribution.+             -> Blur src acc res+gaussianBlur !radius !mSig =+    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel vert horiz) +           (\_ _ -> ()) (FilterFold (const 0)) (\_ _ _ !acc -> round acc)+           BorderReplicate+  where+    !size = radius * 2 + 1++    -- If σ is not provided, tries to fit 3σ in the kernel.+    !sig = case mSig of Just s  -> s+                        Nothing -> (0.5 + fromIntegral radius) / 3++    vert  _ !(Z :. y) !val !acc = let !coeff = kernelVec V.! y+                                  in acc + fromIntegral val * coeff++    horiz _ !(Z :. x) !val !acc = let !coeff = kernelVec V.! x+                                  in acc + val * coeff++    !kernelVec =+        -- Creates a vector of Gaussian values and normalizes it so its sum+        -- equals 1.+        let !unormalized = V.generate size $ \x ->+                                gaussian $! fromIntegral $! abs $! x - radius+            !kernelSum   = V.sum unormalized+        in V.map (/ kernelSum) unormalized++    gaussian !x = invSigSqrt2Pi * exp (inv2xSig2 * square x)++    -- Pre-computed terms of the Gaussian function.+    !invSigSqrt2Pi = 1 / (sig * sqrt (2 * pi))+    !inv2xSig2     = -1 / (2 * square sig)+{-# INLINE gaussianBlur #-}++-- Derivation ------------------------------------------------------------------++type Derivative src res = SeparableFilter src () res res++data DerivativeType = DerivativeX | DerivativeY++-- | Estimates the first derivative using the Scharr's 3x3 kernel.+--+-- Convolves the following kernel for the X derivative:+--+-- @+--  -3   0   3+-- -10   0  10+--  -3   0   3+-- @+--+-- And this kernel for the Y derivative:+--+-- @+--  -3 -10  -3+--   0   0   0+--   3  10   3+-- @+--+-- Considers using a signed integer type for 'res' with+-- @maxBound res >= 16 * maxBound src@.+scharr :: (Integral src, Integral res)+       => DerivativeType -> Derivative src res+scharr der =+    let !kernel =+            case der of+                DerivativeX -> SeparableKernel kernel1 kernel2+                DerivativeY -> SeparableKernel kernel2 kernel1+    in Filter (ix2 3 3) KernelAnchorCenter kernel (\_ _ -> ())+              (FilterFold (const 0)) (\_ _ _ !acc -> acc) BorderReplicate+  where+    kernel1 _ !(Z :. 1)  !val !acc = acc + 10 * fromIntegral val+    kernel1 _ !(Z :. _)  !val !acc = acc + 3  * fromIntegral val++    kernel2 _ !(Z :.  0) !val !acc = acc - fromIntegral val+    kernel2 _ !(Z :.  1) !_   !acc = acc+    kernel2 _ !(Z :. ~2) !val !acc = acc + fromIntegral val+{-# INLINE scharr #-}++-- | Estimates the first derivative using a Sobel's kernel.+--+-- Prefer 'scharr' when radius equals @1@ as Scharr's kernel is more accurate+-- and is implemented faster.+--+-- Considers using a signed integer type for 'res' which is significantly larger+-- than 'src', especially for large kernels.+sobel :: (Integral src, Integral res, Storable res)+      => Int        -- ^ Kernel radius.+      -> DerivativeType+      -> Derivative src res+sobel radius der =+    Filter (ix2 size size) KernelAnchorCenter (SeparableKernel vert horiz)+           (\_ _ -> ()) (FilterFold (const 0)) (\_ _ _ !acc -> acc)+           BorderReplicate+  where+    !size = radius * 2 + 1++    vert  _ !(Z :. x) !val !acc = let !coeff = vec1 V.! x+                                  in acc + fromIntegral val * coeff++    horiz _ !(Z :. x) !val !acc = let !coeff = vec2 V.! x+                                  in acc + fromIntegral val * coeff++    !radius' = fromIntegral radius++    (!vec1, !vec2) = case der of DerivativeX -> (vec1', vec2')+                                 DerivativeY -> (vec2', vec1')++    !vec1' = let pows = [ 2^i | i <- [0..radius'] ]+             in V.fromList $ pows ++ (tail (reverse pows))+    !vec2' = V.fromList $ map negate [1..radius'] ++ [0] ++ [1..radius']+{-# INLINE sobel #-}++-- Others ----------------------------------------------------------------------++type Mean src acc res = SeparableFilter src () acc res++-- | Computes the average of a kernel of the given size.+--+-- This is similar to 'blur' but with a rectangular kernel and a 'Fractional'+-- result.+mean :: (Integral src, Integral acc, Fractional res)+     => Size -> SeparableFilter src () acc res+mean size@(Z :. h :. w) =+    Filter size KernelAnchorCenter (SeparableKernel vert horiz) (\_ _ -> ())+           (FilterFold (const 0)) post BorderReplicate+  where+    vert  _ _ !val  !acc = acc + fromIntegral val+    horiz _ _ !acc' !acc = acc + acc'++    !nPixsFactor = 1 / (fromIntegral $! h * w)+    post _ _ _ !acc  = fromIntegral acc * nPixsFactor+{-# INLINE mean #-}++-- -----------------------------------------------------------------------------++square :: Num a => a -> a+square a = a * a++word :: Integral a => a -> Word+word = fromIntegral

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, MultiParamTypeClasses #-}+{-# LANGUAGE BangPatterns+           , MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Vision.Image.Grey.Conversion () where

@@ -6,11 +6,17 @@ import Data.Int  import Vision.Histogram (Histogram, histogram, histogram2D, equalizeImage)+import Vision.Image.Filter (+      DerivativeType, dilate, erode, blur, gaussianBlur, scharr, sobel, mean+    ) import Vision.Image.Grey.Type (Grey, GreyPixel)-import Vision.Image.Threshold (ThresholdType, otsu)+import Vision.Image.Threshold (+      ThresholdType, AdaptiveThresholdKernel, adaptiveThreshold, otsu, scw+    ) import Vision.Image.Transform (       InterpolMethod, crop, resize, horizontalFlip, verticalFlip     )+import Vision.Image.Type (Manifest) import Vision.Primitive (DIM1, DIM3, Rect, Size)  {-# SPECIALIZE histogram :: Maybe DIM1 -> Grey -> Histogram DIM1 Int32@@ -24,10 +30,55 @@ -- FIXME: GHC 7.8.2 fails to specialize {-# SPECIALIZE equalizeImage :: Grey -> Grey #-} +{-# SPECIALIZE dilate       :: Int -> Grey -> Grey #-}+{-# SPECIALIZE erode        :: Int -> Grey -> Grey #-}+{-# SPECIALIZE blur         :: Int -> Grey -> Grey #-}+{-# SPECIALIZE gaussianBlur :: Int -> Maybe Double -> Grey -> Grey #-}+{-# SPECIALIZE gaussianBlur :: Int -> Maybe Float  -> Grey -> Grey #-}+{-# SPECIALIZE scharr       :: DerivativeType -> Grey -> Grey  #-}+{-# SPECIALIZE scharr       :: DerivativeType -> Grey -> Manifest Int16 #-}+{-# SPECIALIZE scharr       :: DerivativeType -> Grey -> Manifest Int32 #-}+{-# SPECIALIZE scharr       :: DerivativeType -> Grey -> Manifest Int   #-}+{-# SPECIALIZE sobel        :: Int -> DerivativeType -> Grey -> Grey #-}+{-# SPECIALIZE sobel        :: Int -> DerivativeType -> Grey+                            -> Manifest Int16 #-}+{-# SPECIALIZE sobel        :: Int -> DerivativeType -> Grey+                            -> Manifest Int32 #-}+{-# SPECIALIZE sobel        :: Int -> DerivativeType -> Grey+                            -> Manifest Int   #-}+{-# SPECIALIZE mean         :: Size -> Grey -> Manifest Double #-}+{-# SPECIALIZE mean         :: Size -> Grey -> Manifest Float #-}++{-# SPECIALIZE adaptiveThreshold :: AdaptiveThresholdKernel Int -> Int+                                 -> GreyPixel+                                 -> ThresholdType GreyPixel GreyPixel+                                 -> Grey -> Grey #-}+{-# SPECIALIZE adaptiveThreshold :: AdaptiveThresholdKernel Int16 -> Int+                                 -> GreyPixel+                                 -> ThresholdType GreyPixel GreyPixel+                                 -> Grey -> Grey  #-}+{-# SPECIALIZE adaptiveThreshold :: AdaptiveThresholdKernel Int32 -> Int+                                 -> GreyPixel+                                 -> ThresholdType GreyPixel GreyPixel+                                 -> Grey -> Grey  #-}+{-# SPECIALIZE adaptiveThreshold :: AdaptiveThresholdKernel Double -> Int+                                 -> GreyPixel+                                 -> ThresholdType GreyPixel GreyPixel+                                 -> Grey -> Grey  #-}+{-# SPECIALIZE adaptiveThreshold :: AdaptiveThresholdKernel Float -> Int+                                 -> GreyPixel+                                 -> ThresholdType GreyPixel GreyPixel+                                 -> Grey -> Grey #-}+{-# SPECIALIZE otsu              :: ThresholdType GreyPixel GreyPixel -> Grey+                                 -> Grey #-}+{-# SPECIALIZE scw               :: Size -> Size -> Double+                                 -> ThresholdType GreyPixel GreyPixel -> Grey+                                 -> Grey #-}+{-# SPECIALIZE scw               :: Size -> Size -> Float+                                 -> ThresholdType GreyPixel GreyPixel -> Grey+                                 -> Grey #-}+ {-# SPECIALIZE crop           :: Rect -> Grey -> Grey #-} {-# SPECIALIZE resize         :: InterpolMethod -> Size -> Grey -> Grey #-} {-# SPECIALIZE horizontalFlip :: Grey -> Grey #-} {-# SPECIALIZE verticalFlip   :: Grey -> Grey #-}--{-# SPECIALIZE otsu           :: ThresholdType GreyPixel GreyPixel -> Grey-                              -> Grey #-}

@@ -1,4 +1,6 @@-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, TypeFamilies #-}+{-# LANGUAGE BangPatterns+           , GeneralizedNewtypeDeriving+           , TypeFamilies #-}  module Vision.Image.Grey.Type (       Grey, GreyPixel (..), GreyDelayed@@ -8,8 +10,9 @@ import Data.Word import Foreign.Storable (Storable) +import Vision.Image.Class (Pixel (..)) import Vision.Image.Interpolate (Interpolable (..))-import Vision.Image.Type (Pixel (..), Manifest, Delayed)+import Vision.Image.Type (Manifest, Delayed)  newtype GreyPixel = GreyPixel Word8     deriving (Bits, Bounded, Enum, Eq, Integral, Num, Ord, Real, Read, Show

@@ -1,4 +1,6 @@-{-# LANGUAGE BangPatterns, MultiParamTypeClasses, PatternGuards #-}+{-# LANGUAGE BangPatterns+           , MultiParamTypeClasses+           , PatternGuards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Vision.Image.HSV.Conversion () where

@@ -1,4 +1,7 @@-{-# LANGUAGE BangPatterns, RecordWildCards, TypeFamilies, TypeOperators #-}+{-# LANGUAGE BangPatterns+           , RecordWildCards+           , TypeFamilies+           , TypeOperators #-}  module Vision.Image.HSV.Type (       HSV, HSVPixel (..), HSVDelayed@@ -9,8 +12,9 @@ import Foreign.Storable (Storable (..)) import Foreign.Ptr (castPtr, plusPtr) +import Vision.Image.Class (Pixel (..)) import Vision.Image.Interpolate (Interpolable (..))-import Vision.Image.Type (Pixel (..), Manifest, Delayed)+import Vision.Image.Type (Manifest, Delayed)  data HSVPixel = HSVPixel {       hsvHue   :: {-# UNPACK #-} !Word8, hsvSat :: {-# UNPACK #-} !Word8

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, FlexibleContexts #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts #-}  -- | Provides a way to estimate the value of a pixel at rational coordinates -- using a linear interpolation.@@ -10,7 +11,7 @@ import Data.RatioInt (denominator, numerator) import Data.Word -import Vision.Image.Type (Pixel (..), Image (..), ImagePixel, ImageChannel)+import Vision.Image.Class (Pixel (..), Image (..), ImagePixel, ImageChannel) import Vision.Primitive (RPoint (..), ix2)  -- | Provides a way to apply the interpolation to every component of a pixel.

@@ -1,5 +1,9 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, RankNTypes, TypeFamilies #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , RankNTypes+           , TypeFamilies #-} +-- | Contains an stateful image type which can be modified inside a 'ST' monad. module Vision.Image.Mutable (       MutableImage (..), create     , MutableManifest (..)@@ -8,18 +12,19 @@ import Control.Monad.Primitive (PrimMonad (..)) import Control.Monad.ST.Safe (ST, runST) import Data.Vector.Storable (MVector)-import qualified Data.Vector.Storable as V-import qualified Data.Vector.Storable.Mutable as MV import Foreign.Storable (Storable) import Prelude hiding (read) -import Vision.Image.Type (Image, Pixel, ImagePixel, Manifest (..))+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as MV++import Vision.Image.Class (Image, ImagePixel)+import Vision.Image.Type (Manifest (..)) import Vision.Primitive (-      DIM2, Size, fromLinearIndex, toLinearIndex, shapeLength+      Point, Size, fromLinearIndex, toLinearIndex, shapeLength     )  -- | Class for images which can be constructed from a mutable image.- class Image (Freezed i) => MutableImage i where     -- | The type of the immutable version of the mutable image 'i'.     type Freezed i@@ -37,19 +42,20 @@     new' :: PrimMonad m => Size -> ImagePixel (Freezed i) -> m (i (PrimState m))      -- | Returns the pixel value at @Z :. y :. x@.-    read :: PrimMonad m => i (PrimState m) -> DIM2 -> m (ImagePixel (Freezed i))+    read :: PrimMonad m => i (PrimState m) -> Point+         -> m (ImagePixel (Freezed i))     read !img !ix = img `linearRead` toLinearIndex (mShape img) ix     {-# INLINE read #-}      -- | Returns the pixel value as if the image was a single dimension vector     -- (row-major representation).-    linearRead :: PrimMonad m => i (PrimState m) -> Int-               -> m (ImagePixel (Freezed i))+    linearRead :: PrimMonad m+               => i (PrimState m) -> Int -> m (ImagePixel (Freezed i))     linearRead !img !ix = img `read` fromLinearIndex (mShape img) ix     {-# INLINE linearRead #-}      -- | Overrides the value of the pixel at @Z :. y :. x@.-    write :: PrimMonad m => i (PrimState m) -> DIM2 -> ImagePixel (Freezed i)+    write :: PrimMonad m => i (PrimState m) -> Point -> ImagePixel (Freezed i)           -> m ()     write !img !ix !val = linearWrite img (toLinearIndex (mShape img) ix) val     {-# INLINE write #-}@@ -83,12 +89,12 @@  -- Instances ------------------------------------------------------------------- -data Storable p => MutableManifest p s = MutableManifest {+data MutableManifest p s = MutableManifest {       mmSize   :: !Size     , mmVector :: !(MVector s p)     } -instance (Pixel p, Storable p) => MutableImage (MutableManifest p) where+instance Storable p => MutableImage (MutableManifest p) where     type Freezed (MutableManifest p) = Manifest p      mShape = mmSize

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, MultiParamTypeClasses #-}+{-# LANGUAGE BangPatterns+           , MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Vision.Image.RGB.Conversion () where

@@ -1,4 +1,7 @@-{-# LANGUAGE BangPatterns, RecordWildCards, TypeFamilies, TypeOperators #-}+{-# LANGUAGE BangPatterns+           , RecordWildCards+           , TypeFamilies+           , TypeOperators #-}  module Vision.Image.RGB.Type (       RGB, RGBPixel (..), RGBDelayed@@ -9,8 +12,9 @@ import Foreign.Storable (Storable (..)) import Foreign.Ptr (castPtr, plusPtr) +import Vision.Image.Class (Pixel (..)) import Vision.Image.Interpolate (Interpolable (..))-import Vision.Image.Type (Pixel (..), Manifest, Delayed)+import Vision.Image.Type (Manifest, Delayed)  data RGBPixel = RGBPixel {       rgbRed   :: {-# UNPACK #-} !Word8, rgbGreen :: {-# UNPACK #-} !Word8

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, MultiParamTypeClasses #-}+{-# LANGUAGE BangPatterns+           , MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Vision.Image.RGBA.Conversion () where

@@ -1,4 +1,7 @@-{-# LANGUAGE BangPatterns, RecordWildCards, TypeFamilies, TypeOperators #-}+{-# LANGUAGE BangPatterns+           , RecordWildCards+           , TypeFamilies+           , TypeOperators #-}  module Vision.Image.RGBA.Type (       RGBA, RGBAPixel (..), RGBADelayed@@ -9,8 +12,9 @@ import Foreign.Storable (Storable (..)) import Foreign.Ptr (castPtr, plusPtr) +import Vision.Image.Class (Pixel (..)) import Vision.Image.Interpolate (Interpolable (..))-import Vision.Image.Type (Pixel (..), Manifest, Delayed)+import Vision.Image.Type (Manifest, Delayed)  data RGBAPixel = RGBAPixel {       rgbaRed   :: {-# UNPACK #-} !Word8, rgbaGreen :: {-# UNPACK #-} !Word8

@@ -1,381 +0,0 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances-           , ForeignFunctionInterface, MultiParamTypeClasses #-}---- | Uses the DevIL C library to read and write images from and to files.------ /Note:/ As the underlier DevIL library is *not* tread-safe, there is a global--- lock which will prevent two load/save calls to be performed at the same time.-module Vision.Image.Storage (-      ImageType (..), StorageImage (..), StorageError (..), load, loadBS, save-    ) where--import Control.Applicative ((<$>))-import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar)-import Control.Monad (when)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Error (Error (..), ErrorT, runErrorT, throwError)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS-import Data.Convertible (Convertible (..), convert)-import Data.Int-import Data.Vector.Storable (unsafeFromForeignPtr0, unsafeWith)-import Data.Word-import Foreign.C.String (CString, withCString)-import Foreign.Concurrent (newForeignPtr)-import Foreign.Marshal.Alloc (alloca)-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (Ptr, castPtr)-import Foreign.Storable (peek)-import System.IO.Unsafe (unsafePerformIO)--import Vision.Image.Grey (Grey, GreyPixel)-import Vision.Image.RGBA (RGBA, RGBAPixel)-import Vision.Image.RGB (RGB, RGBPixel)-import Vision.Image.Type (Manifest (..), Delayed (..), delay, nChannels)-import Vision.Primitive (Z (..), (:.) (..), ix2)--data StorageImage = GreyStorage Grey | RGBAStorage RGBA | RGBStorage RGB--data ImageType = BMP | CUT-               | DDS         -- ^ DirectDraw Surface (.dds).-               | Doom        -- ^ Doom texture.-               | DoomFlat    -- ^ Doom flat texture (floor).-               | GIF | ICO | JPG-               | LIF         -- ^ Homeworld (.lif).-               | MNG | PCD | PCX | PIC | PNG-               | PNM         -- ^ Portable AnyMap (.pbm, .pgm or .ppm).-               | PSD | PSP | SGI | TGA | TIFF-               | RAW         -- Raw data with a 13-byte header.-    deriving (Eq, Show)--data StorageError = FailedToInit     -- ^ Failed to initialise the library.-                  | FailedToOpenFile -- ^ Failed to open the given file.-                  | InvalidType      -- ^ The file could not be loaded based-                                     -- on extension or header.-                  | OutOfMemory      -- ^ Could not allocate memory for the new-                                     -- image data.-                  | FailedToLoad     -- ^ Failed to load the image, invalid-                                     -- format.-                  | FailedToHaskell  -- ^ Failed to convert the loaded image to-                                     -- its Haskell representation.-                  | FailedToDevil    -- ^ Failed to write the image content-                                     -- through the inner DevIL library.-                  | FailedToSave     -- ^ Could not open the file for writing.-                  | UnknownError (Maybe String)-    deriving (Eq)--type StorageMonad = ErrorT StorageError IO--instance Convertible StorageImage StorageImage where-    safeConvert = Right--instance Convertible (Manifest GreyPixel) StorageImage where-    safeConvert = Right . GreyStorage--instance Convertible (Manifest RGBAPixel) StorageImage where-    safeConvert = Right . RGBAStorage--instance Convertible (Manifest RGBPixel) StorageImage where-    safeConvert = Right . RGBStorage--instance Convertible StorageImage (Manifest GreyPixel) where-    safeConvert (GreyStorage img) = Right img-    safeConvert (RGBAStorage img) = Right $ convert img-    safeConvert (RGBStorage img)  = Right $ convert img--instance Convertible StorageImage (Manifest RGBAPixel) where-    safeConvert (GreyStorage img) = Right $ convert img-    safeConvert (RGBAStorage img) = Right img-    safeConvert (RGBStorage img)  = Right $ convert img--instance Convertible StorageImage (Manifest RGBPixel) where-    safeConvert (GreyStorage img) = Right $ convert img-    safeConvert (RGBAStorage img) = Right $ convert img-    safeConvert (RGBStorage img)  = Right img--instance Convertible StorageImage (Delayed GreyPixel) where-    safeConvert (GreyStorage img) = Right $ delay img-    safeConvert (RGBAStorage img) = Right $ convert img-    safeConvert (RGBStorage img)  = Right $ convert img--instance Convertible StorageImage (Delayed RGBAPixel) where-    safeConvert (GreyStorage img) = Right $ convert img-    safeConvert (RGBAStorage img) = Right $ delay img-    safeConvert (RGBStorage img)  = Right $ convert img--instance Convertible StorageImage (Delayed RGBPixel) where-    safeConvert (GreyStorage img) = Right $ convert img-    safeConvert (RGBAStorage img) = Right $ convert img-    safeConvert (RGBStorage img)  = Right $ delay img--instance Error StorageError where-    noMsg  = UnknownError Nothing-    strMsg = UnknownError . Just--instance Show StorageError where-    show FailedToInit     = "Failed to initialise the DevIL library."-    show FailedToOpenFile = "Failed to open the given file."-    show InvalidType      =-        "The file could not be loaded based on extension or header."-    show OutOfMemory      = "Could not allocate memory for the new image data."-    show FailedToLoad     = "Failed to load the image."-    show FailedToHaskell  =-        "Failed to convert the loaded image to its Haskell representation."-    show FailedToDevil    =-        "Failed to write the image content through the inner DevIL library."-    show FailedToSave     = "Could not open the file for writing."-    show (UnknownError (Just msg)) = msg-    show (UnknownError Nothing   ) = "Unknown error."---- | Reads an image into a manifest vector from a file.------ If no image type is given, type will be determined automatically.-load :: Maybe ImageType -> FilePath -> IO (Either StorageError StorageImage)-load mType path =-    lockDevil $-        bindAndLoad $-            withCString path $ \cPath ->-                ilLoadC (toIlType mType) cPath---- | Reads an image into a manifest vector from a strict 'ByteString'.------ If no image type is given, type will be determined automatically.--- TIFF images are not supported.-loadBS :: Maybe ImageType -> BS.ByteString-       -> IO (Either StorageError StorageImage)-loadBS (Just TIFF) _  = return $ Left FailedToLoad-loadBS mType       bs =-    lockDevil $-        bindAndLoad $-            BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->-                ilLoadLC (toIlType mType) ptr (fromIntegral len)---- | Saves the image to the given file.------ /Note:/ The image type is determined by the filename extension.--- Will fail if the file already exists.-save :: (Convertible i StorageImage) => FilePath -> i -> IO (Maybe StorageError)-save path img = lockDevil $ do-    res <- runErrorT $ do-        ilInit-        name <- ilGenImageName-        ilBindImage name--        toDevil $ convert img-        ilSaveImage path--        ilDeleteImage name--    return $ case res of Right () -> Nothing-                         Left err -> Just err---- C wrappers and helpers --------------------------------------------------------devilLock :: MVar ()-devilLock = unsafePerformIO $ newMVar ()-{-# NOINLINE devilLock #-}---- | Uses a global lock ('devilLock') to prevent two threads to call the--- library at the same time.-lockDevil :: IO a -> IO a-lockDevil action = do-    takeMVar devilLock-    ret <- action-    putMVar devilLock ()-    return ret---- | Allocates a new image name, executes the given action to load the image--- and then converts it into its Haskell representation.-bindAndLoad :: IO ILboolean ->  IO (Either StorageError StorageImage)-bindAndLoad action = runErrorT $ do-    ilInit-    name <- ilGenImageName-    ilBindImage name--    res <- lift action-    when (res == 0) $ do-        err <- lift ilGetErrorC-        throwError $ case err of-            (#const IL_COULD_NOT_OPEN_FILE) -> FailedToOpenFile-            (#const IL_INVALID_EXTENSION)   -> InvalidType-            (#const IL_INVALID_FILE_HEADER) -> InvalidType-            (#const IL_OUT_OF_MEMORY)       -> OutOfMemory-            _                               -> FailedToLoad--    fromDevil name--toIlType :: Maybe ImageType -> ILenum-toIlType (Just BMP)      = (#const IL_BMP)-toIlType (Just CUT)      = (#const IL_CUT)-toIlType (Just DDS)      = (#const IL_DDS)-toIlType (Just Doom)     = (#const IL_DOOM)-toIlType (Just DoomFlat) = (#const IL_DOOM_FLAT)-toIlType (Just GIF)      = (#const IL_GIF)-toIlType (Just ICO)      = (#const IL_ICO)-toIlType (Just JPG)      = (#const IL_JPG)-toIlType (Just LIF)      = (#const IL_LIF)-toIlType (Just MNG)      = (#const IL_MNG)-toIlType (Just PCD)      = (#const IL_PCD)-toIlType (Just PCX)      = (#const IL_PCX)-toIlType (Just PIC)      = (#const IL_PIC)-toIlType (Just PNG)      = (#const IL_PNG)-toIlType (Just PNM)      = (#const IL_PNM)-toIlType (Just PSD)      = (#const IL_PSD)-toIlType (Just PSP)      = (#const IL_PSP)-toIlType (Just SGI)      = (#const IL_SGI)-toIlType (Just TGA)      = (#const IL_TGA)-toIlType (Just TIFF)     = (#const IL_TIF)-toIlType (Just RAW)      = (#const IL_RAW)-toIlType Nothing         = (#const IL_TYPE_UNKNOWN)--#include "IL/il.h"--type ILuint    = #type ILuint-type ILsizei   = #type ILsizei-type ILboolean = #type ILboolean-type ILenum    = #type ILenum-type ILint     = #type ILint-type ILubyte   = #type ILubyte---- DevIL uses unsigned integers as names for each image in processing.-newtype ImageName = ImageName ILuint-    deriving (Show)--foreign import ccall unsafe "ilInit" ilInitC :: IO ()-foreign import ccall unsafe "ilGetError" ilGetErrorC :: IO ILenum-foreign import ccall unsafe "ilOriginFunc" ilOriginFuncC-    :: ILenum -> IO ILboolean-foreign import ccall unsafe "ilEnable" ilEnableC :: ILenum -> IO ILboolean--il_RGB, il_RGBA, il_LUMINANCE :: ILenum-il_RGB = (#const IL_RGB)-il_RGBA = (#const IL_RGBA)-il_LUMINANCE = (#const IL_LUMINANCE)--il_IMAGE_HEIGHT, il_IMAGE_WIDTH :: ILenum-il_IMAGE_FORMAT, il_IMAGE_TYPE :: ILenum-il_IMAGE_HEIGHT = (#const IL_IMAGE_HEIGHT)-il_IMAGE_WIDTH  = (#const IL_IMAGE_WIDTH)-il_IMAGE_FORMAT = (#const IL_IMAGE_FORMAT)-il_IMAGE_TYPE   = (#const IL_IMAGE_TYPE)--il_UNSIGNED_BYTE :: ILenum-il_UNSIGNED_BYTE = (#const IL_UNSIGNED_BYTE)---- | Initialize the library.-ilInit :: StorageMonad ()-ilInit = do-    lift ilInitC--    -- By default, origin is undefined and depends on the image type-    ilOriginFuncC (#const IL_ORIGIN_LOWER_LEFT) <?> FailedToInit-    ilEnableC (#const IL_ORIGIN_SET)            <?> FailedToInit--foreign import ccall unsafe "ilGenImages" ilGenImagesC-  :: ILsizei -> Ptr ILuint -> IO ()---- | Allocates a new image name.-ilGenImageName :: StorageMonad ImageName-ilGenImageName = lift $ do-    alloca $ \pName -> do-        ilGenImagesC 1 pName-        name <- peek pName-        return $! ImageName name--foreign import ccall unsafe "ilBindImage" ilBindImageC :: ILuint -> IO ()---- | Sets the image name as the current image for processing.-ilBindImage :: ImageName -> StorageMonad ()-ilBindImage (ImageName name) = lift $ ilBindImageC name--foreign import ccall unsafe "ilLoad" ilLoadC :: ILenum -> CString-                                             -> IO ILboolean-foreign import ccall unsafe "ilLoadL" ilLoadLC :: ILenum -> CString -> ILuint-                                               -> IO ILboolean--foreign import ccall unsafe "ilGetInteger" ilGetIntegerC :: ILenum -> IO ILint-foreign import ccall unsafe "ilConvertImage" ilConvertImageC-    :: ILenum -> ILenum -> IO ILboolean-foreign import ccall unsafe "ilGetData" ilGetDataC :: IO (Ptr ILubyte)-foreign import ccall unsafe "ilDeleteImages" ilDeleteImagesC-    :: ILsizei -> Ptr ILuint -> IO ()---- | Puts the current image inside a 'Vector'.-fromDevil :: ImageName -> StorageMonad StorageImage-fromDevil (ImageName name) = do-    format <- ilGetInteger il_IMAGE_FORMAT-    w      <- ilGetInteger il_IMAGE_WIDTH-    h      <- ilGetInteger il_IMAGE_HEIGHT-    let !size = ix2 h w--    case format of-        _ | format == il_RGB -> do-            convertChannels il_RGB-            RGBStorage <$> toManifest size-          | format == il_RGBA -> do-            convertChannels il_RGBA-            RGBAStorage <$> toManifest size-          | format == il_RGBA -> do-            convertChannels il_LUMINANCE-            GreyStorage <$> toManifest size-          | otherwise -> do -- Unsupported formats are converted to RGBA.-            ilConvertImage il_RGBA il_UNSIGNED_BYTE-            RGBAStorage <$> toManifest size-  where-    -- Converts the image to the given format if the pixel type isn't Word8.-    convertChannels destFormat = do-        pixelType <- ilGetInteger il_IMAGE_TYPE-        when (pixelType /= il_UNSIGNED_BYTE) $-            ilConvertImage destFormat il_UNSIGNED_BYTE--    -- Converts the C vector of unsigned bytes to a garbage collected 'Vector'-    -- inside a 'Manifest' image.-    toManifest size@(Z :. h :. w) = lift $ do-        pixels        <- castPtr <$> ilGetDataC-        managedPixels <- newForeignPtr pixels (with name (ilDeleteImagesC 1))-        return $! Manifest size (unsafeFromForeignPtr0 managedPixels (w * h))--    ilGetInteger mode = lift $ fromIntegral <$> ilGetIntegerC mode--    ilConvertImage format pixelType = do-        ilConvertImageC format pixelType <?> FailedToHaskell---- | Removes the image and any allocated memory.-ilDeleteImage :: ImageName -> StorageMonad ()-ilDeleteImage (ImageName name) = lift $ with name (ilDeleteImagesC 1)--foreign import ccall unsafe "ilTexImage" ilTexImageC-    :: ILuint -> ILuint -> ILuint   -- w h depth-    -> ILubyte -> ILenum -> ILenum  -- numberOfChannels format type-    -> Ptr ()                       -- data (copy from this pointer)-    -> IO ILboolean---- | Sets the current DevIL image to the vector's internal array.-toDevil :: StorageImage -> StorageMonad ()-toDevil storImg =-    case storImg of GreyStorage img -> writeManifest img il_LUMINANCE-                    RGBAStorage img -> writeManifest img il_RGBA-                    RGBStorage  img -> writeManifest img il_RGB-  where-    writeManifest img@(Manifest (Z :. h :. w) vec) format =-        (unsafeWith vec $ \p ->-            ilTexImageC (fromIntegral w) (fromIntegral h) 1-                        (fromIntegral $ nChannels img)-                        format il_UNSIGNED_BYTE (castPtr p)-        ) <?> FailedToDevil--foreign import ccall unsafe "ilSaveImage" ilSaveImageC-    :: CString -> IO ILboolean---- | Saves the current image.-ilSaveImage :: FilePath -> StorageMonad ()-ilSaveImage file = withCString file ilSaveImageC <?> FailedToSave--infix 0 <?>--- | Wraps a breakable DevIL action (which returns 0 on failure) in the--- 'StorageMonad'. Throws the given error in the monad if the action fails.-(<?>) :: IO ILboolean -> StorageError -> StorageMonad ()-action <?> err = do-    res <- lift action-    when (res == 0) $-        throwError err

@@ -1,44 +1,78 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, GADTs #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , GADTs #-}  module Vision.Image.Threshold (-      ThresholdType (..)+    -- * Simple threshold+      ThresholdType (..), thresholdType     , threshold-    , AdaptiveThresholdKernel (..), adaptiveThreshold-    , otsu+    -- * Adaptive threshold+    , AdaptiveThresholdKernel (..), AdaptiveThreshold+    , adaptiveThreshold, adaptiveThresholdFilter+    -- * Other methods+    , otsu, scw     ) where +import Data.Int import Foreign.Storable (Storable) -import Vision.Image.Filter (Filter (..), SeparableFilter, blur, gaussianBlur)-import Vision.Image.Type (ImagePixel, FunctorImage)-import Vision.Histogram-import Vision.Histogram as H-import Vision.Primitive.Shape (shapeLength)-import qualified Vision.Image.Type as I- import qualified Data.Vector.Storable as V import qualified Data.Vector as VU +import Vision.Image.Class (+      Image, ImagePixel, FromFunction (..), FunctorImage, (!), shape+    )+import Vision.Image.Filter.Internal (+      Filter (..), BoxFilter, Kernel (..), SeparableFilter, SeparatelyFiltrable+    , KernelAnchor (KernelAnchorCenter), FilterFold (..)+    , BorderInterpolate (BorderReplicate)+    , apply, blur, gaussianBlur, Mean, mean+    )+import Vision.Image.Type (Manifest, delayed, manifest)+import Vision.Histogram (+      HistogramShape, PixelValueSpace, ToHistogram, histogram+    )+import Vision.Primitive (Z (..), (:.) (..), Size, shapeLength)++import qualified Vision.Histogram as H+import qualified Vision.Image.Class as I+ -- | Specifies what to do with pixels matching the threshold predicate. -- -- @'BinaryThreshold' a b@ will replace matching pixels by @a@ and non-matchings -- pixels by @b@. -- -- @'Truncate' a@ will replace matching pixels by @a@.+--+-- @'TruncateInv' a@ will replace non-matching pixels by @a@. data ThresholdType src res where     BinaryThreshold :: res -> res -> ThresholdType src res     Truncate        :: src        -> ThresholdType src src+    TruncateInv     :: src        -> ThresholdType src src +-- | Given the thresholding method, a boolean indicating if the pixel match the+-- thresholding condition and the pixel, returns the new pixel value.+thresholdType :: ThresholdType src res -> Bool -> src -> res+thresholdType (BinaryThreshold ifTrue ifFalse) match _   | match     = ifTrue+                                                         | otherwise = ifFalse+thresholdType (Truncate        ifTrue)         match pix | match     = ifTrue+                                                         | otherwise = pix+thresholdType (TruncateInv     ifFalse)        match pix | match     = pix+                                                         | otherwise = ifFalse+{-# INLINE thresholdType #-}++-- -----------------------------------------------------------------------------+ -- | Applies the given predicate and threshold policy on the image. threshold :: FunctorImage src res           => (ImagePixel src -> Bool)           -> ThresholdType (ImagePixel src) (ImagePixel res) -> src -> res-threshold !cond !(BinaryThreshold ifTrue ifFalse) !img =-    I.map (\pix -> if cond pix then ifTrue else ifFalse) img-threshold !cond !(Truncate        ifTrue)         !img =-    I.map (\pix -> if cond pix then ifTrue else pix)     img+threshold !cond !thresType =+    I.map (\pix -> thresholdType thresType (cond pix) pix) {-# INLINE threshold #-} +-- -----------------------------------------------------------------------------+ -- | Defines how pixels of the kernel of the adaptive threshold will be -- weighted. --@@ -52,34 +86,62 @@     GaussianKernel :: (Floating acc, RealFrac acc)                    => Maybe acc -> AdaptiveThresholdKernel acc --- | Applies a thresholding adaptively.+-- | Compares every pixel to its surrounding ones in the kernel of the given+-- radius.+adaptiveThreshold :: ( Image src, Integral (ImagePixel src)+                     , Ord (ImagePixel src)+                     , FromFunction res, Integral (FromFunctionPixel res)+                     , Storable acc+                     , SeparatelyFiltrable src res acc)+                  => AdaptiveThresholdKernel acc+                  -> Int+                  -- ^ Kernel radius.+                  -> ImagePixel src+                  -- ^ Minimum difference between the pixel and the kernel+                  -- average. The pixel is thresholded if+                  -- @pixel_value - kernel_mean > difference@ where difference+                  -- is this number. Can be negative.+                  -> ThresholdType (ImagePixel src) (FromFunctionPixel res)+                  -> src+                  -> res+adaptiveThreshold kernelType radius thres thresType img =+    adaptiveThresholdFilter kernelType radius thres thresType `apply` img+{-# INLINABLE adaptiveThreshold #-}++type AdaptiveThreshold src acc res = SeparableFilter src () acc res++-- | Creates an adaptive thresholding filter to be used with 'apply'. --+-- Use 'adaptiveThreshold' if you only want to apply the filter on the image.+-- -- Compares every pixel to its surrounding ones in the kernel of the given -- radius.-adaptiveThreshold :: (Integral src, Num src, Ord src, Storable acc)-                  => AdaptiveThresholdKernel acc-                  -> Int -- ^ Kernel radius.-                  -> src -- ^ Minimum difference between the pixel and the-                         -- kernel average. The pixel is thresholded if-                         -- @pixel_value - kernel_mean > difference@ where-                         -- difference if this number. Can be negative.-                  -> ThresholdType src res -> SeparableFilter src acc res-adaptiveThreshold !kernelType !radius !thres !thresType =+adaptiveThresholdFilter :: (Integral src, Ord src, Storable acc)+                        => AdaptiveThresholdKernel acc+                        -> Int+                        -- ^ Kernel radius.+                        -> src+                        -- ^ Minimum difference between the pixel and the kernel+                        -- average. The pixel is thresholded if+                        -- @pixel_value - kernel_mean > difference@ where+                        -- difference is this number. Can be negative.+                        -> ThresholdType src res+                        -> AdaptiveThreshold src acc res+adaptiveThresholdFilter !kernelType !radius !thres !thresType =     kernelFilter { fPost = post }   where     !kernelFilter =         case kernelType of MeanKernel         -> blur         radius                            GaussianKernel sig -> gaussianBlur radius sig -    post !pix !acc =-        let !acc' = (fPost kernelFilter) pix acc+    post ix pix ini acc =+        let !acc' = (fPost kernelFilter) ix pix ini acc             !cond = (pix - acc') > thres-        in case thresType of-                BinaryThreshold ifTrue ifFalse -> if cond then ifTrue-                                                          else ifFalse-                Truncate        ifTrue         -> if cond then ifTrue else pix-{-# INLINE adaptiveThreshold #-}+        in thresholdType thresType cond pix+{-# INLINE adaptiveThresholdFilter #-} +-- -----------------------------------------------------------------------------+ -- | Applies a clustering-based image thresholding using the Otsu's method. -- -- See <https://en.wikipedia.org/wiki/Otsu's_method>.@@ -114,6 +176,62 @@      !two    = 2 :: Int {-# INLINABLE otsu #-}++-- -----------------------------------------------------------------------------++-- | This is a sliding concentric window filter (SCW) that uses the ratio of the+-- standard deviations of two sliding windows centered on a same point to detect+-- regions of interest (ROI).+--+-- > scw sizeWindowA sizeWindowB beta thresType img+--+-- Let @σA@ be the standard deviation of a fist window around a pixel and @σB@+-- be the standard deviation of another window around the same pixel.+-- Then the pixel will match the threshold if @σB / σA >= beta@, and will be+-- thresholded according to the given 'ThresholdType'.+--+-- See <http://www.academypublisher.com/jcp/vol04/no08/jcp0408771777.pdf>.+scw :: ( Image src, Integral (ImagePixel src), FromFunction dst+       , Floating stdev, Fractional stdev, Ord stdev, Storable stdev)+    => Size -> Size -> stdev+    -> ThresholdType (ImagePixel src) (FromFunctionPixel dst) -> src -> dst+scw !sizeA !sizeB !beta !thresType !img =+    betaThreshold (stdDev sizeA) (stdDev sizeB)+  where+    betaThreshold a b =+        fromFunction (shape img) $ \pt ->+            let !cond = (b ! pt) / (a ! pt) < beta+            in thresholdType thresType cond (img ! pt)++    stdDev size =+       let filt :: (Integral src, Fractional res) => Mean src Int16 res+           filt     = mean size+           !meanImg = manifest $ apply filt img+           !varImg  = manifest $ apply (variance size meanImg) img+       in delayed $ I.map sqrt varImg+{-# INLINABLE scw #-}++-- | Given a mean image and an original image, computes the variance of the+-- kernel of the given size.+--+-- @average [ (origPix - mean)^2 | origPix <- kernel pixels on original ]@.+variance :: (Integral src, Fractional res, Storable res)+         => Size -> Manifest res -> BoxFilter src res res res+variance !size@(Z :. h :. w) !meanImg =+    Filter size KernelAnchorCenter (Kernel kernel) (\pt _ -> meanImg ! pt)+           (FilterFold (const 0)) post BorderReplicate+  where+    kernel !kernelMean _ !val !acc =+        acc + square (fromIntegral val - kernelMean)++    !nPixsFactor = 1 / (fromIntegral $! h * w)+    post _ _ _ !acc  = acc * nPixsFactor+{-# INLINABLE variance #-}++-- -----------------------------------------------------------------------------++square :: Num a => a -> a+square a = a * a  double :: Integral a => a -> Double double = fromIntegral

@@ -1,4 +1,6 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, TypeFamilies #-}+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , TypeFamilies #-}  -- | Provides high level functions to do geometric transformations on images. --@@ -12,11 +14,11 @@ import Control.Monad.Primitive (PrimMonad (..)) import Data.RatioInt (RatioInt, (%)) +import Vision.Image.Class (+      MaskedImage (..), Image (..), ImageChannel, FromFunction (..), (!)+    ) import Vision.Image.Interpolate (Interpolable, bilinearInterpol) import Vision.Image.Mutable (MutableImage (..))-import Vision.Image.Type (-      MaskedImage (..), Image (..), ImageChannel, FromFunction (..)-    ) import Vision.Primitive (       Z (..), (:.) (..), Point, RPoint (..), Rect (..), Size, ix2, toLinearIndex     )@@ -34,7 +36,7 @@      => Rect -> i1 -> i2 crop !(Rect rx ry rw rh) !img =     fromFunction (Z :. rh :. rw) $ \(Z :. y :. x) ->-        img `index` ix2 (ry + y) (rx + x)+        img ! ix2 (ry + y) (rx + x) {-# INLINABLE crop #-}  -- | Resizes the 'Image' using the given interpolation method.@@ -51,7 +53,7 @@                 col  !x' = truncate $ (double x' + 0.5) * widthRatio  - 0.5                 {-# INLINE col #-}                 f !y !(Z :. _ :. x') = let !x = col x'-                                       in img `index` ix2 y x+                                       in img ! ix2 y x                 {-# INLINE f #-}             in fromFunctionLine size' line f         NearestNeighbor ->@@ -62,7 +64,7 @@                 col  !x' = round $ (double x' + 0.5) * widthRatio  - 0.5                 {-# INLINE col #-}                 f !y !(Z :. _ :. x') = let !x = col x'-                                       in img `index` ix2 y x+                                       in img ! ix2 y x                 {-# INLINE f #-}             in fromFunctionLine size' line f         Bilinear ->@@ -95,7 +97,7 @@                => i1 -> i2 horizontalFlip !img =     let f !(Z :. y :. x') = let !x = maxX - x'-                            in img `index` ix2 y x+                            in img ! ix2 y x         {-# INLINE f #-}     in fromFunction size f   where@@ -110,7 +112,7 @@ verticalFlip !img =     let line !y' = maxY - y'         {-# INLINE line #-}-        f !y !(Z :. _ :. x) = img `index` ix2 y x+        f !y !(Z :. _ :. x) = img ! ix2 y x         {-# INLINE f #-}     in fromFunctionLine size line f   where

@@ -1,245 +1,63 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances-           , MultiParamTypeClasses, PatternGuards, TypeFamilies+{-# LANGUAGE BangPatterns+           , FlexibleContexts+           , FlexibleInstances+           , MultiParamTypeClasses+           , PatternGuards+           , TypeFamilies            , UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Vision.Image.Type (-    -- * Classes-      Pixel (..), MaskedImage (..), Image (..), ImageChannel, FromFunction (..)-    , FunctorImage (..)     -- * Manifest images-    , Manifest (..)+      Manifest (..)     -- * Delayed images     , Delayed (..)     -- * Delayed masked images     , DelayedMask (..)-    -- * Functions-    , nChannels, pixel-    -- * Conversion-    , Convertible (..), convert, delay, compute-    -- * Types helpers-    , delayed, manifest+    -- * Conversion and type helpers+    , delay, compute, delayed, manifest     ) where  import Control.Applicative ((<$>))-import Data.Convertible (Convertible (..), convert)-import Data.Int-import Data.Vector.Storable (-      Vector, (!), create, enumFromN, forM_, generate, unfoldr-    )+import Control.DeepSeq (NFData (..))+import Data.Vector.Storable (Vector, create, enumFromN, forM_, generate) import Data.Vector.Storable.Mutable (new, write)-import Data.Word import Foreign.Storable (Storable) import Prelude hiding (map, read) -import Vision.Primitive (-      Z (..), (:.) (..), Point, Size-    , ix2, fromLinearIndex, toLinearIndex, shapeLength-    )---- Classes ------------------------------------------------------------------------- | Determines the number of channels and the type of each pixel of the image--- and how images are represented.-class Storable p => Pixel p where-    type PixelChannel p--    -- | Returns the number of channels of the pixel.-    -- Must not consume 'p' (could be 'undefined').-    pixNChannels :: p -> Int--    pixIndex :: p -> Int -> PixelChannel p--instance Pixel Int16 where-    type PixelChannel Int16 = Int16-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Int32 where-    type PixelChannel Int32 = Int32-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Int where-    type PixelChannel Int = Int-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word8 where-    type PixelChannel Word8 = Word8-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word16 where-    type PixelChannel Word16 = Word16-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word32 where-    type PixelChannel Word32 = Word32-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Word where-    type PixelChannel Word = Word-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Float where-    type PixelChannel Float = Float-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Double where-    type PixelChannel Double = Double-    pixNChannels _   = 1-    pixIndex     p _ = p--instance Pixel Bool where-    type PixelChannel Bool = Bool-    pixNChannels _   = 1-    pixIndex     p _ = p---- | Provides an abstraction for images which are not defined for each of their--- pixels. The interface is similar to 'Image' except that indexing functions--- don't always return.--- Image origin is located in the lower left corner.-class Pixel (ImagePixel i) => MaskedImage i where-    type ImagePixel i--    shape :: i -> Size--    -- | Returns the pixel\'s value at 'Z :. y, :. x'.-    maskedIndex :: i -> Point -> Maybe (ImagePixel i)-    maskedIndex img = (img `maskedLinearIndex`) . toLinearIndex (shape img)-    {-# INLINE maskedIndex #-}--    -- | Returns the pixel\'s value as if the image was a single dimension-    -- vector (row-major representation).-    maskedLinearIndex :: i -> Int -> Maybe (ImagePixel i)-    maskedLinearIndex img = (img `maskedIndex`) . fromLinearIndex (shape img)-    {-# INLINE maskedLinearIndex #-}--    -- | Returns the non-masked values of the image.-    values :: i -> Vector (ImagePixel i)-    values !img =-        unfoldr step 0-      where-        !n = shapeLength (shape img)--        step !i | i >= n                              = Nothing-                | Just p <- img `maskedLinearIndex` i = Just (p, i + 1)-                | otherwise                           = step (i + 1)-    {-# INLINE values #-}--    {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-}--type ImageChannel i = PixelChannel (ImagePixel i)---- | Provides an abstraction over the internal representation of an image.--- Image origin is located in the lower left corner.-class MaskedImage i => Image i where-    -- | Returns the pixel value at 'Z :. y :. x'.-    index :: i -> Point -> ImagePixel i-    index img = (img `linearIndex`) . toLinearIndex (shape img)-    {-# INLINE index #-}--    -- | Returns the pixel value as if the image was a single dimension vector-    -- (row-major representation).-    linearIndex :: i -> Int -> ImagePixel i-    linearIndex img = (img `index`) . fromLinearIndex (shape img)-    {-# INLINE linearIndex #-}--    -- | Returns every pixel values as if the image was a single dimension-    -- vector (row-major representation).-    vector :: i -> Vector (ImagePixel i)-    vector img = generate (shapeLength $ shape img) (img `linearIndex`)-    {-# INLINE vector #-}--    {-# MINIMAL index | linearIndex #-}---- | Provides ways to construct an image from a function.-class FromFunction i where-    type FromFunctionPixel i--    -- | Generates an image by calling the given function for each pixel of the-    -- constructed image.-    fromFunction :: Size -> (Point -> FromFunctionPixel i) -> i--    -- | Generates an image by calling the last function for each pixel of the-    -- constructed image.-    -- The first function is called for each line, generating a line invariant-    -- value.-    -- This function is faster for some image representations as some recurring-    -- computation can be cached.-    fromFunctionLine :: Size -> (Int -> a)-                     -> (a -> Point -> FromFunctionPixel i) -> i-    fromFunctionLine size line f =-        fromFunction size (\pt@(Z :. y :. _) -> f (line y) pt)-    {-# INLINE fromFunctionLine #-}--    -- | Generates an image by calling the last function for each pixel of the-    -- constructed image.-    -- The first function is called for each column, generating a column-    -- invariant value.-    -- This function *can* be faster for some image representations as some-    -- recurring computations can be cached. However, it may requires a vector-    -- allocation for these values. If the column invariant is cheap to-    -- compute, prefer 'fromFunction'.-    fromFunctionCol :: Storable b => Size -> (Int -> b)-                    -> (b -> Point -> FromFunctionPixel i) -> i-    fromFunctionCol size col f =-        fromFunction size (\pt@(Z :. _ :. x) -> f (col x) pt)-    {-# INLINE fromFunctionCol #-}--    -- | Generates an image by calling the last function for each pixel of the-    -- constructed image.-    -- The two first functions are called for each line and for each column,-    -- respectively, generating common line and column invariant values.-    -- This function is faster for some image representations as some recurring-    -- computation can be cached. However, it may requires a vector-    -- allocation for column values. If the column invariant is cheap to-    -- compute, prefer 'fromFunctionLine'.-    fromFunctionCached :: Storable b => Size-                       -> (Int -> a)               -- ^ Line function-                       -> (Int -> b)               -- ^ Column function-                       -> (a -> b -> Point-                           -> FromFunctionPixel i) -- ^ Pixel function-                       -> i-    fromFunctionCached size line col f =-        fromFunction size (\pt@(Z :. y :. x) -> f (line y) (col x) pt)-    {-# INLINE fromFunctionCached #-}--    {-# MINIMAL fromFunction #-}+import qualified Data.Vector.Storable as V --- | Defines a class for images on which a function can be applied. The class is--- different from 'Functor' as there could be some constraints and--- transformations the pixel and image types.-class (MaskedImage src, MaskedImage res) => FunctorImage src res where-    map :: (ImagePixel src -> ImagePixel res) -> src -> res+import Vision.Image.Class (+      MaskedImage (..), Image (..), FromFunction (..), FunctorImage (..)+    , Convertible (..), (!), convert+    )+import Vision.Primitive (Z (..), (:.) (..), Point, Size, ix2)  -- Manifest images -------------------------------------------------------------  -- | Stores the image content in a 'Vector'.-data Storable p => Manifest p = Manifest {+data Manifest p = Manifest {       manifestSize   :: !Size     , manifestVector :: !(Vector p)     } deriving (Eq, Ord, Show) -instance Pixel p => MaskedImage (Manifest p) where+instance NFData (Manifest p) where+    rnf !_ = ()++instance Storable p => MaskedImage (Manifest p) where     type ImagePixel (Manifest p) = p      shape = manifestSize     {-# INLINE shape #-} -    Manifest _ vec `maskedLinearIndex` ix = Just $! vec ! ix+    Manifest _ vec `maskedLinearIndex` ix = Just $! vec V.! ix     {-# INLINE maskedLinearIndex #-}      values = manifestVector     {-# INLINE values #-} -instance Pixel p => Image (Manifest p) where-    Manifest _ vec `linearIndex` ix = vec ! ix+instance Storable p => Image (Manifest p) where+    Manifest _ vec `linearIndex` ix = vec V.! ix     {-# INLINE linearIndex #-}      vector = manifestVector@@ -287,7 +105,7 @@                 let !lineOffset = y * w                 forM_ (enumFromN 0 w) $ \x -> do                     let !offset = lineOffset + x-                        !val    = f (cols ! x) (ix2 y x)+                        !val    = f (cols V.! x) (ix2 y x)                     write arr offset val              return arr@@ -305,7 +123,7 @@                     !lineOffset = y * w                 forM_ (enumFromN 0 w) $ \x -> do                     let !offset = lineOffset + x-                        !val    = f lineVal (cols ! x) (ix2 y x)+                        !val    = f lineVal (cols V.! x) (ix2 y x)                     write arr offset val              return arr@@ -313,8 +131,8 @@         !cols = generate w col     {-# INLINE fromFunctionCached #-} -instance (Image src, Pixel p) => FunctorImage src (Manifest p) where-    map f img = fromFunction (shape img) (f . (img `index`))+instance (Image src, Storable p) => FunctorImage src (Manifest p) where+    map f img = fromFunction (shape img) (f . (img !))     {-# INLINE map #-}  -- Delayed images --------------------------------------------------------------@@ -330,7 +148,7 @@     , delayedFun  :: !(Point -> p)     } -instance Pixel p => MaskedImage (Delayed p) where+instance Storable p => MaskedImage (Delayed p) where     type ImagePixel (Delayed p) = p      shape = delayedSize@@ -339,7 +157,7 @@     maskedIndex img = Just . delayedFun img     {-# INLINE maskedIndex #-} -instance Pixel p => Image (Delayed p) where+instance Storable p => Image (Delayed p) where     index = delayedFun     {-# INLINE index #-} @@ -349,8 +167,8 @@     fromFunction = Delayed     {-# INLINE fromFunction #-} -instance (Image src, Pixel p) => FunctorImage src (Delayed p) where-    map f img = fromFunction (shape img) (f . (img `index`))+instance (Image src, Storable p) => FunctorImage src (Delayed p) where+    map f img = fromFunction (shape img) (f . (img !))     {-# INLINE map #-}  -- Masked delayed images -------------------------------------------------------@@ -360,7 +178,7 @@     , delayedMaskFun  :: !(Point -> Maybe p)     } -instance Pixel p => MaskedImage (DelayedMask p) where+instance Storable p => MaskedImage (DelayedMask p) where     type ImagePixel (DelayedMask p) = p      shape = delayedMaskSize@@ -369,31 +187,18 @@     maskedIndex = delayedMaskFun     {-# INLINE maskedIndex #-} -instance Pixel p => FromFunction (DelayedMask p) where+instance Storable p => FromFunction (DelayedMask p) where     type FromFunctionPixel (DelayedMask p) = Maybe p      fromFunction = DelayedMask     {-# INLINE fromFunction #-} -instance (MaskedImage src, Pixel p) => FunctorImage src (DelayedMask p) where+instance (MaskedImage src, Storable p) => FunctorImage src (DelayedMask p) where     map f img = fromFunction (shape img) (\pt -> f <$> (img `maskedIndex` pt))     {-# INLINE map #-} --- Functions ------------------------------------------------------------------- --- | Returns the number of channels of an image.-nChannels :: MaskedImage i => i -> Int-nChannels img = pixNChannels (pixel img)-{-# INLINE nChannels #-}---- | Returns an 'undefined' instance of a pixel of the image. This is sometime--- useful to satisfy the type checker as in a call to 'pixNChannels' :------ > nChannels img = pixNChannels (pixel img)-pixel :: MaskedImage i => i -> ImagePixel i-pixel _ = undefined---- Conversion ------------------------------------------------------------------+-- Conversion and type helpers -------------------------------------------------  -- | Delays an image in its delayed representation. delay :: Image i => i -> Delayed (ImagePixel i)@@ -405,32 +210,30 @@ compute = map id {-# INLINE compute #-} -instance (Pixel p1, Pixel p2, Storable p1, Storable p2, Convertible p1 p2)+instance (Storable p1, Storable p2, Convertible p1 p2)     => Convertible (Manifest p1) (Manifest p2) where     safeConvert = Right . map convert     {-# INLINE safeConvert #-} -instance (Pixel p1, Pixel p2, Convertible p1 p2)+instance (Storable p1, Storable p2, Convertible p1 p2)     => Convertible (Delayed p1) (Delayed p2) where     safeConvert = Right . map convert     {-# INLINE safeConvert #-} -instance (Pixel p1, Pixel p2, Storable p2, Convertible p1 p2)+instance (Storable p1, Storable p2, Convertible p1 p2)     => Convertible (Delayed p1) (Manifest p2) where     safeConvert = Right . map convert     {-# INLINE safeConvert #-} -instance (Pixel p1, Pixel p2, Storable p1, Convertible p1 p2)+instance (Storable p1, Storable p2, Convertible p1 p2)     => Convertible (Manifest p1) (Delayed  p2) where     safeConvert = Right . map convert     {-# INLINE safeConvert #-} --- Types helpers ---------------------------------------------------------------------- -- | Forces an image to be in its delayed represenation. Does nothing. delayed :: Delayed p -> Delayed p delayed = id --- | Forces an image to be in its delayed represenation. Does nothing.+-- | Forces an image to be in its manifest represenation. Does nothing. manifest :: Manifest p -> Manifest p manifest = id

@@ -9,8 +9,17 @@  import Vision.Primitive.Shape +-- | Coordinates inside the image.+--+-- Can be constructed using 'ix2'. The first parameter is the y coordinate while+-- the second is the x coordinate (i.e. @'ix2' y x@). Image origin (@'ix2' 0 0@)+-- is located in the upper left corner. type Point = DIM2 +-- | Size of an object.+--+-- Can be constructed using 'ix2'. The first parameter is the height while the+-- second is the width (i.e. @ix2 h w@). type Size = DIM2  data Rect = Rect {

@@ -1,4 +1,6 @@-{-# LANGUAGE BangPatterns, FlexibleInstances, TypeOperators #-}+{-# LANGUAGE BangPatterns+           , FlexibleInstances+           , TypeOperators #-}  -- | 'Shape's are similar to what you could found in @repa@. 'Shape' are used -- both for indexes and shapes.