MeanShift-0.1: Examples/MeanShiftFilter.hs

{-#LANGUAGE BangPatterns#-}
module Main where
import Data.List hiding (sum)
import qualified Data.Vector.Unboxed as V
import Prelude hiding (sum)
import Control.Arrow
import MeanShift
import CV.Image
import CV.Pixelwise
import CV.Transforms
import System.Environment
import Data.Maybe
import Control.Monad

-- | Extract a pixel from an image.
sample :: (Int,Int) -> Image RGB D32 -> (Int,Int) -> Vector
sample (w,h) image (!x,!y)
   | x>0 && y>0 && x < w && y < h = let (r,g,b) = getPixel (x,y) image
                                    in V.fromList [fi x, fi y, colorScale*realToFrac r, colorScale*realToFrac g, colorScale*realToFrac b]
   | otherwise = V.fromList [fi x, fi y, 0,0,0]

-- | Extract color and coordinate information from the sample (see above.) 
coord v = let (!x):(!y):_ = V.toList v in (round x,round y)
color v = let _:_:r:g:b:_ = V.toList v in (realToFrac (b/colorScale), realToFrac (g/colorScale), realToFrac (r/colorScale))

-- | Weighting term to balance the effect between spatial and color domains.
colorScale = 50

main :: IO ()
main = do
   [fn] <- getArgs
   image <- readFromFile fn
   let -- Reading the test-data. You might want to scale it to smaller size to avoid waiting too much. 
       testData :: Image RGB D32
       testData =  image 
       (w,h) = getSize testData

       -- A windowing function that is used to extract image patches. 
       window :: Window
       window (x,s) = [sample (w,h) testData (u+j,v+i)
                      | let size  = round s
                      , i <- [-size,-size+1..size]
                      , j <- [-size,-size+1..size]
                      , let (u,v) = coord x
                      ]

       -- Application of meanshift to the image data.
       shift   = meanShiftWindow 5 window 3
       process = last . take 12 . fixedPointE 0.1 shift
       
       -- The resulting image. This will be evaluated in parallel if you compile with `-rtsopt -threaded`-options and
       -- execute the resulting program with `-RTS -N` flags
       r :: Image RGB D32
       r = toImagePar 8 $ MkP (getSize testData) (color . process . sample (w,h) testData)
   saveImage "filtered.png" r
   return ()