Sharpening doesn't work - How to properly do math on Pixel8(Word8) integer values? - Convolution Image Processing in Haskell

Question

I'm trying to make sharpness filter in Haskell using JuicyPixels. And I've made same Gaussian blur function and it works fine, but that one doesn't. These (Int, Int, Int) tuples are my workaround for storing negative pixel values. T means tuples there in names.

pxMultNumT :: (Int, Int, Int) -> Double -> (Int, Int, Int)
pxMultNumT (r, g, b) q =  (m r, m g, m b)
  where m p = floor $ fromIntegral p * q

pxPlusT :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
pxPlusT (r1, g1, b1) (r2, g2, b2) = (r1 + r2, g1 + g2, b1 + b2)

fromPixelT :: PixelRGBA8 -> (Int, Int, Int)
fromPixelT (PixelRGBA8 r g b a) = (convert r, convert g, convert b)

toPixelT :: (Int, Int, Int) -> PixelRGBA8 
toPixelT (r,g,b) = PixelRGBA8 (fromInteger $ toInteger r) (fromInteger $ toInteger g) (fromInteger $ toInteger b) 255

sharpen :: Image PixelRGBA8 -> Image PixelRGBA8 
sharpen img@Image {..} = generateImage blurrer imageWidth imageHeight
       where blurrer x y | x >= (imageWidth - offset) || x < offset
                          || y >= (imageHeight - offset) || y < offset = whitePx
                         | otherwise = do
                let applyKernel i j p | j >= matrixLength = applyKernel (i + 1) 0 p
                                      | i >= matrixLength = toPixelT p 
                                      | otherwise = do 
                                         let outPixelT = pxMultNumT
                                                            (fromPixelT (pixelAt img (x + j - offset) (y + i - offset)))
                                                             (kernel !! i !! j)
                                         applyKernel i (j+1) (outPixelT `pxPlusT` p)
                applyKernel 0 0 (0,0,0)
             kernel = [[   0, -0.5,    0],
                       [-0.5,    3, -0.5],
                       [   0, -0.5,    0]]
             matrixLength = length kernel
             offset = matrixLength `div` 2

And here are input image: and output image: So, what did I wrong here?

Edit: I rewrote functions like this

sharpen :: Image PixelRGBA8 -> Image PixelRGBA8 
sharpen img@Image {..} = promoteImage $ generateImage blurrer imageWidth imageHeight
       where blurrer x y | x >= (imageWidth - offset) || x < offset
                          || y >= (imageHeight - offset) || y < offset = PixelRGB8 0 0 0
                         | otherwise = do
                let applyKernel i j p | j >= matrixLength = applyKernel (i + 1) 0 p
                                      | i >= matrixLength = normalizePixel p 
                                      | otherwise = do 
                                         let outPixel = pxMultNum
                                                          (promotePixel $ dropTransparency $ pixelAt img (x + j - offset) (y + i - offset))
                                                           (kernel !! i !! j)
                                         applyKernel i (j+1) (pxPlus outPixel p)
                applyKernel 0 0 (PixelRGBF 0 0 0)
             kernel = [[ -1, -1, -1],
                       [-1,   9, -1],
                       [ -1, -1, -1]]
             matrixLength = length kernel
             offset = matrixLength `div` 2

pxPlus :: PixelRGBF -> PixelRGBF -> PixelRGBF
pxPlus (PixelRGBF r1 g1 b1) (PixelRGBF r2 g2 b2) = PixelRGBF (r1 + r2) (g1 + g2) (b1 + b2)

pxMultNum :: PixelRGBF -> Float -> PixelRGBF 
pxMultNum (PixelRGBF r g b) q = PixelRGBF (r * q) (g * q) (b * q)

normalizePixel :: PixelRGBF -> PixelRGB8 
normalizePixel (PixelRGBF r g b) = PixelRGB8 (n r) (n g) (n b)
  where n f = floor $ 255 * f

and now it works!

user_1848029 · Answer

The short answer to your question is to use Double or Float instead of working with integral precision per channel. You are not gaining anything but this sort of overflow problems. Scaling [0, 255] range to [0.0, 1.0] should be the first step before you start doing image processing.

See my answer to your other question for more details on what you should do to improve your implementation. Here is also a proper solution to this problem as well:


import Data.Massiv.Array as A
import Data.Massiv.Array.Unsafe (makeStencil)
import Data.Massiv.Array.IO as A


sharpenImageF :: (ColorModel cs Float) => Image S cs Float -> Image S cs Float
sharpenImageF = compute . applyStencil padding sharpStencil
  where
    padding = noPadding -- decides what happens at the border
{-# INLINE sharpenImageF #-}


sharpStencil :: (Floating e, ColorModel cs e) => Stencil Ix2 (Pixel cs e) (Pixel cs e)
sharpStencil = makeStencil (Sz2 3 3) (1 :. 1) stencil
  where
    stencil f =                   (-0.5) * f (-1 :. 0)
                - 0.5 * f ( 0 :. -1) + 3 * f ( 0 :. 0) - 0.5 * f ( 0 :. 1)
                                   - 0.5 * f ( 1 :. 0)
    {-# INLINE stencil #-}
{-# INLINE sharpStencil #-}

λ> img <- readImageAuto "4ZYKa.jpg" :: IO (Image S (SRGB 'Linear) Float)
λ> let imgSharpened = sharpenImageF img
λ> imgCropped <- extractM (1 :. 1) (size imgSharpened) img
λ> imgBoth <- appendM 1 imgCropped imgSharpened
λ> let out = convertPixel <$> imgBoth :: Image DL (Y'CbCr SRGB) Word8
λ> writeImage "out.jpg" $ computeAs S out

Sharpening doesn't work - How to properly do math on Pixel8(Word8) integer values? - Convolution Image Processing in Haskell

1 Answers