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!
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

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With