hip 1.5.4.0 → 1.5.5.0

raw patch · 7 files changed

+113/−76 lines, 7 filesdep ~JuicyPixelsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: JuicyPixels

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• hip.cabal +2/−2
• src/Graphics/Image/IO.hs +1/−2
• src/Graphics/Image/IO/Formats/JuicyPixels.hs +31/−1
• src/Graphics/Image/Processing/Ahe.hs +33/−29
• src/Graphics/Image/Processing/Filter.hs +25/−27
• src/Graphics/Image/Processing/Hough.hs +15/−14

@@ -1,10 +1,15 @@+1.5.5.0+=======++* Ability to encode animated gifs+ 1.5.4.0 =======  * Addition of `disable-chart` flag * Bunch of semi-functional stuff from GSoC 2018 -1.5.2.0+1.5.3.0 =======  * Fixed FFT performace issue

@@ -1,5 +1,5 @@ Name:              hip-Version:           1.5.4.0+Version:           1.5.5.0 License:           BSD3 License-File:      LICENSE Author:            Alexey Kuleshevich@@ -36,7 +36,7 @@   HS-Source-Dirs: src    Build-Depends:-                 JuicyPixels     >= 3.2.7+                 JuicyPixels     >= 3.3.5                , base            >= 4.5 && < 5                , bytestring      >= 0.9.0.4                , colour          >= 2.3.3

@@ -156,8 +156,7 @@ -- 'RGBA' 'Double') would be written as @RGBA16@, hence preserving transparency -- and using highest supported precision 'Word16'. At the same time, writing -- that image in 'GIF' format would save it in @RGB8@, since 'Word8' is the--- highest precision 'GIF' supports and it currently cannot be saved with--- transparency.+-- highest precision 'GIF' supports. writeImage :: (Array VS cs e, Array arr cs e,                Writable (Image VS cs e) OutputFormat) =>               FilePath            -- ^ Location where an image should be written.

@@ -79,7 +79,7 @@ import qualified Data.Monoid                     as M (mempty) import qualified Data.Vector.Storable            as V import           Graphics.Image.ColorSpace-import           Graphics.Image.Interface        as I+import           Graphics.Image.Interface        as I hiding (map) import           Graphics.Image.Interface.Vector (VS) import           Graphics.Image.IO.Base @@ -168,6 +168,10 @@ fromJPImageY16 = jpImageToImageUnsafe {-# INLINE fromJPImageY16 #-} +fromJPImageY32 :: JP.Image JP.Pixel32 -> Image VS Y Word32+fromJPImageY32 = jpImageToImageUnsafe+{-# INLINE fromJPImageY32 #-}+ fromJPImageYA8 :: JP.Image JP.PixelYA8 -> Image VS YA Word8 fromJPImageYA8 = jpImageToImageUnsafe {-# INLINE fromJPImageYA8 #-}@@ -280,6 +284,7 @@ jpDynamicImageToImage (JP.ImageY8 jimg)     = convert $ fromJPImageY8 jimg jpDynamicImageToImage (JP.ImageYA8 jimg)    = convert $ fromJPImageYA8 jimg jpDynamicImageToImage (JP.ImageY16 jimg)    = convert $ fromJPImageY16 jimg+jpDynamicImageToImage (JP.ImageY32 jimg)    = convert $ fromJPImageY32 jimg jpDynamicImageToImage (JP.ImageYA16 jimg)   = convert $ fromJPImageYA16 jimg jpDynamicImageToImage (JP.ImageYF jimg)     = convert $ fromJPImageYF jimg jpDynamicImageToImage (JP.ImageRGB8 jimg)   = convert $ fromJPImageRGB8 jimg@@ -296,6 +301,7 @@ jpImageShowCS :: JP.DynamicImage -> String jpImageShowCS (JP.ImageY8 _)     = "Y8 (Pixel Y Word8)" jpImageShowCS (JP.ImageY16 _)    = "Y16 (Pixel Y Word16)"+jpImageShowCS (JP.ImageY32 _)    = "Y32 (Pixel Y Word32)" jpImageShowCS (JP.ImageYF _)     = "YF (Pixel Y Float)" jpImageShowCS (JP.ImageYA8 _)    = "YA8 (Pixel YA Word8)" jpImageShowCS (JP.ImageYA16 _)   = "YA16 (Pixel YA Word16)"@@ -416,6 +422,7 @@ instance ImageFormat (Seq GIF) where   data SaveOption (Seq GIF) = GIFSeqPalette JP.PaletteOptions                             | GIFSeqLooping JP.GifLooping+                            | GIFSeqDisposal JP.GifDisposalMethod   ext _ = ext GIF  @@ -585,8 +592,31 @@     {-# INLINE palletizeGif #-} {-# INLINE encodeGIFSeq #-} +{-# INLINE encodeGIFSeqA #-}+encodeGIFSeqA :: [SaveOption (Seq GIF)]+           -> [(JP.GifDelay, Image VS RGBA Word8)] -> BL.ByteString+encodeGIFSeqA !opts frms =+  case output of+    Left err -> error err+    Right res -> res+  where width = JP.imageWidth $ snd $ head jPimgs+        height = JP.imageHeight $ snd $ head jPimgs+        jPimgs = map (\(d,i) -> (d,toJPImageRGBA8 i)) frms+        frames = JP.palettizeWithAlpha jPimgs $ getGIFSeqDisposal opts+        getGIFSeqDisposal []                          = JP.DisposalRestoreBackground+        getGIFSeqDisposal (GIFSeqDisposal disposal:_) = disposal+        getGIFSeqDisposal (_:xs)                      = getGIFSeqDisposal xs+        getGIFSeqLoop []                  = JP.LoopingNever+        getGIFSeqLoop (GIFSeqLooping l:_) = l+        getGIFSeqLoop (_:xs)              = getGIFSeqLoop xs+        input = JP.GifEncode width height Nothing Nothing (getGIFSeqLoop opts) frames+        output = JP.encodeComplexGifImage input+ instance Writable [(JP.GifDelay, Image VS RGB Word8)] (Seq GIF) where   encode _ opts = encodeGIFSeq opts++instance Writable [(JP.GifDelay, Image VS RGBA Word8)] (Seq GIF) where+  encode _ opts = encodeGIFSeqA opts  instance Writable [(JP.GifDelay, Image VS RGB Double)] (Seq GIF) where   encode _ opts = encodeGIFSeq opts . fmap (fmap toWord8I)

@@ -1,23 +1,23 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns #-}  -- | Adaptive histogram equalization is used to improve contrast in images. -- It adjusts image intensity in small regions (neighborhood) in the image.+--+-- /__Warning__/ - This module is experimental and likely doesn't work as expected module Graphics.Image.Processing.Ahe where  import Control.Monad (forM_, when) import Control.Monad.ST-import Data.STRef -import Debug.Trace (trace)+import Data.STRef  import Prelude as P hiding (subtract) import Graphics.Image.Processing.Filter import Graphics.Image.Interface as I import Graphics.Image import Graphics.Image.Types as IP-import Graphics.Image.ColorSpace (X)  -- | Supplementary function for applying border resolution and a general mask. simpleFilter :: (Array arr cs e, Array arr X e) => Direction -> Border (Pixel cs e) -> Filter arr cs e@@ -26,60 +26,64 @@   where     !kernel =       case dir of-        Vertical   -> fromLists $ [ [ 0, -1, 0 ], [  -1,  4,  -1 ], [  0,  -1,  0 ] ]-        Horizontal -> fromLists $ [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ]+        Vertical   -> fromLists [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ]+        Horizontal -> fromLists [ [ 0, -1, 0 ], [ -1, 4, -1 ], [ 0, -1, 0 ] ]  -- | 'ahe' operates on small 'contextual' regions of the image. It enhances the contrast of each -- region and this technique works well when the distribution of pixel values is similar throughout--- the image. +-- the image. -- -- The idea is to perform contrast enhancement in 'neighborhood region' of each pixel and the size--- of the region is a parameter of the method. It constitutes a characteristic length scale: contrast +-- of the region is a parameter of the method. It constitutes a characteristic length scale: contrast -- at smaller scales is enhanced, while contrast at larger scales is reduced (For general purposes, a size -- factor of 5 tends to give pretty good results). -- -- <<images/yield.jpg>>   <<images/yield_ahe.png>> ----- Usage : ---	+-- Usage :+-- -- >>> img <- readImageY VU "images/yield.jpg" -- >>> input1 <- getLine -- >>> input2 <- getLine -- >>> let thetaSz = (P.read input1 :: Int)--- >>> let distSz = (P.read input2 :: Int) --- >>> let neighborhoodFactor = (P.read input2 :: Int) --- >>> let aheImage :: Image VU RGB Double--- >>>     aheImage = ahe img thetaSz distSz neighborhoodFactor+-- >>> let distSz = (P.read input2 :: Int)+-- >>> let neighborhoodFactor = (P.read input2 :: Int)+-- >>> let aheImage = ahe img thetaSz distSz neighborhoodFactor :: Image VU RGB Double -- >>> writeImage "images/yield_ahe.png" (toImageRGB aheImage) ---ahe-  :: forall arr e cs . ( MArray arr Y Double, IP.Array arr Y Double, IP.Array arr Y Word16, MArray arr Y Word16, Array arr X Double)+ahe ::+     forall arr.+     ( MArray arr Y Double+     , IP.Array arr Y Double+     , IP.Array arr Y Word16+     , MArray arr Y Word16+     , Array arr X Double+     )   => Image arr Y Double-  -> Int  -- ^ width of output image-  -> Int  -- ^ height of output image -  -> Int  -- ^ neighborhood size factor+  -> Int -- ^ width of output image+  -> Int -- ^ height of output image+  -> Int -- ^ neighborhood size factor   -> Image arr Y Word16 ahe image thetaSz distSz neighborhoodFactor = I.map (fmap toWord16) accBin  where-   ip = applyFilter (simpleFilter Horizontal Edge) image  -- Pre-processing (Border resolution) -   widthMax, var1, heightMax, var2 :: Int+   ip = applyFilter (simpleFilter Horizontal Edge) image  -- Pre-processing (Border resolution)+   _widthMax, var1, _heightMax, var2 :: Int    var1 = ((rows ip) - 1)-   widthMax = ((rows ip) - 1)+   _widthMax = ((rows ip) - 1)    var2 = ((cols ip) - 1)-   heightMax = ((cols ip) - 1)-    +   _heightMax = ((cols ip) - 1)+    accBin :: Image arr Y Word16    accBin = runST $                -- Core part of the Algo begins here.      do arr <- I.new (thetaSz, distSz)   -- Create a mutable image with the given dimensions.         forM_ [0 .. var1] $ \x -> do           forM_ [0 .. var2] $ \y -> do             rankRef <- newSTRef (0 :: Int)-            let neighborhood a maxValue = filter (\a -> a >= 0 && a < maxValue) [a-5 .. a+5] +            let neighborhood a maxValue = filter (\a -> a >= 0 && a < maxValue) [a-5 .. a+5]             forM_ (neighborhood x var1) $ \i -> do-              forM_ (neighborhood y var2) $ \j -> do  +              forM_ (neighborhood y var2) $ \j -> do                  when (I.index ip (x, y) > I.index ip (i, j)) $ modifySTRef' rankRef (+1)             rank <- readSTRef rankRef-            let px = ((rank * 255))  +            let px = ((rank * 255))             I.write arr (x, y) (PixelY (fromIntegral px))-        freeze arr   -+        freeze arr

@@ -14,7 +14,7 @@ -- module Graphics.Image.Processing.Filter   ( -- * Filter-    Filter (..)+    Filter (Filter)   , applyFilter   , Direction(..)     -- * Gaussian@@ -32,10 +32,10 @@   , logFilter     -- * Gaussian Smoothing   , gaussianSmoothingFilter-    -- * Mean +    -- * Mean   , meanFilter     -- * Unsharp Masking-  , unsharpMaskingFilter  +  , unsharpMaskingFilter   ) where  @@ -158,8 +158,8 @@ laplacianFilter !border =   Filter (correlate border kernel)   where-    !kernel = fromLists $ [ [ -1, -1, -1 ]   -- Unlike the Sobel edge detector, the Laplacian edge detector uses only one kernel. -                        , [  -1, 8, -1 ]     -- It calculates second order derivatives in a single pass. +    !kernel = fromLists $ [ [ -1, -1, -1 ]   -- Unlike the Sobel edge detector, the Laplacian edge detector uses only one kernel.+                        , [  -1, 8, -1 ]     -- It calculates second order derivatives in a single pass.                         , [  -1, -1, -1 ]]   -- This is the approximated kernel used for it. (Includes diagonals) {-# INLINE laplacianFilter #-} @@ -167,7 +167,7 @@ -- an image before applying some derivative filter on it. This comes in -- need for reducing the noise sensitivity while working with noisy -- datasets or in case of approximating second derivative measurements.--- +-- -- The LoG operator takes the second derivative of the image. Where the image -- is basically uniform, the LoG will give zero. Wherever a change occurs, the LoG will -- give a positive response on the darker side and a negative response on the lighter side.@@ -191,15 +191,15 @@                           , [  0,  1,  1, 2, 2, 2, 1, 1, 0  ] ] {-# INLINE logFilter #-} --- | The Gaussian smoothing operator is a 2-D convolution operator that is used to --- `blur' images and remove detail and noise. The idea of Gaussian smoothing is to use --- this 2-D distribution as a `point-spread' function, and this is achieved by convolution. --- Since the image is stored as a collection of discrete pixels we need to produce a --- discrete approximation to the Gaussian function before we can perform the convolution. +-- | The Gaussian smoothing operator is a 2-D convolution operator that is used to+-- `blur' images and remove detail and noise. The idea of Gaussian smoothing is to use+-- this 2-D distribution as a `point-spread' function, and this is achieved by convolution.+-- Since the image is stored as a collection of discrete pixels we need to produce a+-- discrete approximation to the Gaussian function before we can perform the convolution. -- More info about the algo at <https://homepages.inf.ed.ac.uk/rbf/HIPR2/gsmooth.htm>--- --- <<images/GSM_gsn_yield_IP.jpg>> <<images/GSM_gsn_yield_OP.png>>  --+-- <<images/GSM_gsn_yield_IP.jpg>> <<images/GSM_gsn_yield_OP.png>>+-- gaussianSmoothingFilter :: (Fractional e, Array arr cs e, Array arr X e) =>                            Border (Pixel cs e) -> Filter arr cs e gaussianSmoothingFilter !border =@@ -211,32 +211,32 @@                           ,[  4, 16, 26, 16, 4 ]                           ,[ 1, 4, 7, 4, 1 ]] -{-# INLINE gaussianSmoothingFilter #-}    +{-# INLINE gaussianSmoothingFilter #-}  --- | The mean filter is a simple sliding-window spatial filter that replaces the --- center value in the window with the average (mean) of all the pixel values in --- the window. The window, or kernel, can be any shape, but this one uses the most +-- | The mean filter is a simple sliding-window spatial filter that replaces the+-- center value in the window with the average (mean) of all the pixel values in+-- the window. The window, or kernel, can be any shape, but this one uses the most -- common 3x3 square kernel. -- More info about the algo at <http://homepages.inf.ed.ac.uk/rbf/HIPR2/mean.htm>--- +-- -- <<images/yield.jpg>>   <<images/yield_mean.png>>--- +-- meanFilter :: (Fractional e, Array arr cs e, Array arr X e) =>                            Border (Pixel cs e) -> Filter arr cs e meanFilter !border =   Filter (I.map (/ 9) . correlate border kernel)-  where +  where     !kernel = fromLists $[ [ 1, 1, 1 ]       -- Replace each pixel with the mean value of its neighbors, including itself.-                          , [  1, 1, 1 ]   +                          , [  1, 1, 1 ]                           , [  1, 1, 1 ]]  {-# INLINE meanFilter #-}  -- | The unsharp-masking filter is a sharpening operator which derives its name from--- the fact that it enhances edges (and other high frequency components in an image) +-- the fact that it enhances edges (and other high frequency components in an image) -- via a procedure which subtracts an unsharp, or smoothed, version of an image from--- the original image. It is commonly used in the photographic and printing industries +-- the original image. It is commonly used in the photographic and printing industries -- for crispening edges. -- More info about the algo at <https://homepages.inf.ed.ac.uk/rbf/HIPR2/unsharp.htm> --@@ -246,13 +246,11 @@                            Border (Pixel cs e) -> Filter arr cs e unsharpMaskingFilter !border =   Filter (I.map (/256) . correlate border kernel)-  where -    !kernel = fromLists $ [[ -1, -4, -6, -4, -1 ]     +  where+    !kernel = fromLists $ [[ -1, -4, -6, -4, -1 ]                           ,[  -4, -16, -24, -16, -4 ]    -- Uses negative image to create a mask of the original image.                           ,[  -6, -24, 476, -24, -6 ]    -- The unsharped mask is then combined with the positive (original) image.                           ,[  -4, -16, -24, -16, -4 ]    -- So, the resulting image is less blurry, i.e clearer.                           ,[ -1, -4, -6, -4, -1 ]]  {-# INLINE unsharpMaskingFilter #-}--

@@ -2,9 +2,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Hough Transform is used as a part of feature extraction in images. +-- | Hough Transform is used as a part of feature extraction in images. -- It is a tool that makes it far easier to identify straight lines in -- the source image, whatever their orientation.+--+-- /__Warning__/ - This module is experimental and likely doesn't work as expected module Graphics.Image.Processing.Hough where  import Control.Monad (forM_, when)@@ -18,7 +20,7 @@ import Graphics.Image.Types as IP  -- | Some helper functions :--- | Trivial function for subtracting co-ordinate pairs +-- | Trivial function for subtracting co-ordinate pairs sub :: Num x => (x, x) -> (x, x) -> (x, x) sub (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) @@ -34,25 +36,25 @@ mag :: Floating x => (x, x) -> x mag x = sqrt (dotProduct x x) --- | 'hough' computes the Linear Hough Transform and maps each point in the target image, ​ (ρ, θ) ​ --- to the average color of the pixels on  the corresponding line of the source image ​(x,y) ​- space,--- where the line corresponds to points of the form ​(xcosθ + ysinθ = ρ(rho)). +-- | 'hough' computes the Linear Hough Transform and maps each point in the target image, (ρ, θ)+-- to the average color of the pixels on  the corresponding line of the source image (x,y) - space,+-- where the line corresponds to points of the form (xcosθ + ysinθ = ρ(rho)). ----- The idea is that where there is a straight line in the original image, it corresponds to a --- bright (or dark, depending on the color of the background field) spot; by applying a suitable +-- The idea is that where there is a straight line in the original image, it corresponds to a+-- bright (or dark, depending on the color of the background field) spot; by applying a suitable -- filter to the results of the transform, it is possible to extract the locations of the lines in the original image. -- -- <<images/yield.jpg>>   <<images/yield_hough.png>> ----- Usage : ---	--- >>> frog <- readImageRGB VU "yield.jpg"+-- Usage :+--+-- >>> yield <- readImageRGB VU "yield.jpg" -- >>> input1 <- getLine -- >>> input2 <- getLine -- >>> let thetaSz = (P.read input1 :: Int) -- >>> let distSz = (P.read input2 :: Int) -- >>> let houghImage :: Image VU RGB Double--- >>>     houghImage = hough frog thetaSz distSz+-- >>>     houghImage = hough yield thetaSz distSz -- >>> writeImage "test.png" houghImage -- hough@@ -80,7 +82,7 @@    slopeMap = [ ((x, y), slope x y) | x <- [0 .. widthMax], y <- [0 .. heightMax] ]     distMax :: Double -- Compute Maximum distance-   distMax = (sqrt . fromIntegral $ (heightMax + 1) ^ (2 :: Int) + (widthMax + 1) ^ (2 :: Int)) / 2 +   distMax = (sqrt . fromIntegral $ (heightMax + 1) ^ (2 :: Int) + (widthMax + 1) ^ (2 :: Int)) / 2     accBin = runSTArray $   -- Core part of Algo begins here. Working in a safe way with a mutable array.      do arr <- newArray ((0, 0), (thetaSz, distSz)) (0 :: Double) -- Build a new array, with every element initialised to the supplied value.@@ -99,11 +101,10 @@                      writeArray arr idx (old + 1)         return arr -   maxAcc = F.maximum accBin  +   maxAcc = F.maximum accBin    hTransform (x, y) =         let l = 255 - truncate ((accBin ! (x, y)) / maxAcc * 255) -- pixel generating function         in PixelY l     hImage :: Image arr Y Word8    hImage = makeImage (thetaSz, distSz) hTransform-