Filling the enclosed areas with random colors - Haskell - Friday

Question

I am trying to perform not very complex image analysis to try and find distinct shapes and calculate some of their parameters like area and perimeter (in pixels) and I am trying to do this in Haskell (I wanted to do that to try and work with functional programming language).

The first task in line is to count the amount of spoons on the image: I am using Friday Haskell package to work with images.

My idea was to use the Friday's edge detection and then fill all of the enclosed areas with it's fill function. The first one would require me to iterate over image's pixels until i've stumbled upon a black pixel. Than I would fill the area and continue the search in the image (which now has one of it's objects filled). I could color different objects with random colors and associate these colors with their objects to find their areas and perimeters.

Here is how this image looks after I've applied edge detection to it:

I was unable to find the way of iterating over all of the pixels though. I've found those read and readLinear functions in the following package: https://hackage.haskell.org/package/friday-0.2.2.0/docs/Vision-Image-Mutable.html#v:linearRead, but I am not sure how to use them and I was unable to deduce that from their type signature since I am very very new to Haskell.

Here is the code that does all of the image reading, grayscaling and edge detecting:

{-# LANGUAGE ScopedTypeVariables #-}
import Prelude hiding (filter)
import System.Environment (getArgs)

import Vision.Detector.Edge (canny)
import Vision.Image
import Vision.Image.Storage.DevIL (Autodetect (..), load, save)

detectEdges :: RGBA -> Grey
detectEdges img =
  let grey = convert img :: Grey
      -- Img blurring --
      blurRadius = 2
      blurred = gaussianBlur blurRadius (Nothing :: Maybe Double) grey :: Grey

      -- Sobel applying --
      sobelRadius = 2
      lowThreshold = 256
      highThreshold = 1024
  in (canny sobelRadius lowThreshold highThreshold blurred) :: Grey

processImg :: RGBA -> RGBA
processImg img =
  let edges = detectEdges img
  -- Here goes all of the important stuff
  in convert edges :: RGBA

main :: IO ()
main = do
  [input, output] <- getArgs

  io <- load Autodetect input
  case io of
    Left err             -> do
      putStrLn "Unable to load the image:"
      print err

    Right (img :: RGBA)  -> do
      mErr <- save Autodetect output (processImg img)
      case mErr of
        Nothing  ->
          putStrLn "Success."
        Just err -> do
          putStrLn "Unable to save the image:"
          print err

Thank you in advance.

Answer 1

How do I find area and perimeter of connected components?

You can use the contour tracing from Vision.Image.Contour to get all contour perimeters. First lets start with getting the edges like you have:

{-# LANGUAGE ScopedTypeVariables #-}
import Prelude as P
import System.Environment (getArgs)

import Vision.Detector.Edge (canny)
import Vision.Image
import Vision.Primitive.Shape
import Vision.Image.Storage.DevIL (Autodetect (..), load, save)
import Vision.Image.Transform(floodFill)
import Control.Monad.ST (runST, ST)
import Vision.Image.Contour

-- 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 Autodetect input

    case io of
        Left err             -> do
            putStrLn "Unable to load the image:"
            print err
        Right (grey :: Grey) -> do
            let blurred, edges :: Grey
                edges = canny 2 256 1024 blurred :: Grey

Here's where we acquire contours. Due to a bug in the draw function, which I use later, I'll blur first to get contours with distinct inner and outer points. This will get patched eventually...

                cs           = contours (blur 2 edges :: Grey)
                goodContours = P.filter goodSize (allContourIds cs)

Now we have a value of this Contours type which includes a valid ContourId for each connected component. For each ContourId you can get its area with contourSize and perimeter with contourPerimeter. The size of the perimeter is just the length of the list of perimeter points.

I just did a really overly-tailored filter, called goodSize to get the spoons, but you can play with area and perimeter all you'd like:

                goodSize x   = let ((xmin,xmax),(ymin,ymax)) = contourBox cs x
                               in xmax-xmin > 60 && xmax-xmin < 500 &&
                                  ymax-ymin > 100 && ymax-ymin < 500

                final, filledContours :: RGBA
                filledContours =
                   convert $ drawContours cs (shape edges) Fill goodContours

Optionally, for each contour use floodFill to get a color. Here I just use three colors and fill whichever contours are first in the list. The contours list is ordered top-to-bottom left-to-right so this will look odd-ish. You could sortBy xmin goodContours to get a left-right ordering.

                floodStart = concatMap (take 1 . contourPerimeter cs) goodContours
                colors = cycle [RGBAPixel 255 0 0 255, RGBAPixel 0 255 0 255, RGBAPixel 0 0 255 255]
                final = runST doFill

The fill operation is using the ST monad, which you can find many questions about here on StackOverflow.

                doFill :: forall s. ST s RGBA
                doFill = do
                          m <- thaw filledContours :: ST s (MutableManifest RGBAPixel s)
                          mapM_ (\(p,c) -> floodFill p c m) (zip floodStart colors)
                          return =<< unsafeFreeze m

            -- Saves the edges image. Automatically infers the output format.
            mErr <- save Autodetect output final
            case mErr of
                Nothing  ->
                    putStrLn "Success."
                Just err -> do
                    putStrLn "Unable to save the image:"
                    print err

contourBox cs x =
  let ps = contourPerimeter cs x
      (xs,ys) = unzip $ P.map (\(Z :. x :. y) -> (x,y)) ps
  in ((minimum xs, maximum xs), (minimum ys, maximum ys))

The end result is:

Answer 2

I didn't see a question in your posting, the closest seems to be:

I was unable to find the way of iterating over all of the pixels though.

You can itereate over all the pixels using map but then... that's just a map and you'll get no state (it's not a fold after all). So you might want to make your own primitive recursive function and just index each pixel using index which is the same as !.

You also said:

My idea was to use the Friday's edge detection and then fill all of the enclosed areas with it's fill function.

Well if you fill "all of the enlosed areas" then your whole picture will be white filled with whatever the outer outline is depending on fill strategy - notice the larger rectangle encompassing your whole image. I suggest you do a contour trace and filter on some simple things like perimeter size, height, width, or ratios. My contour modules isn't pushed up to hackage yet but you can get it from github. Notice the drawContour function should work for you once its properly functioning (part of why I won't push it up to Hackage just yet).