From acf53ba4632c884898dec8af36508e0d0ea1c8ed Mon Sep 17 00:00:00 2001 From: Khilan Ravani Date: Tue, 15 May 2018 13:29:15 +0530 Subject: [PATCH 1/7] Initial version --- src/Graphics/Image/HoughTransform.hs | 162 +++++++++++++++++++++++++++ 1 file changed, 162 insertions(+) create mode 100644 src/Graphics/Image/HoughTransform.hs diff --git a/src/Graphics/Image/HoughTransform.hs b/src/Graphics/Image/HoughTransform.hs new file mode 100644 index 0000000..c59370a --- /dev/null +++ b/src/Graphics/Image/HoughTransform.hs @@ -0,0 +1,162 @@ +import Control.Applicative +import System.Environment (getArgs, getProgName) +import Control.Monad (forM_, when) +import Control.Monad.ST +import qualified Data.Foldable as F (maximum) +import Data.Massiv.Array.IO +import Data.List + +import Codec.Picture.Types(dropTransparency) +import Codec.Picture +import Prelude as P +import Graphics.Image.ColorSpace +import Graphics.Image.IO +import Graphics.Image.Interface as I +import Graphics.Image.Types as IP + + +-- ######### Read Image ########## +readImageRGB :: Array arr RGB Double => arr -> FilePath -> IO (Image arr RGB Double) +readImageRGB _ = readImage' + +-- frog <- readImageRGB VU "images/frog.jpg" +-- writeImage "images/frog_eye_grid.png" $ pixelGrid 10 $ crop (51, 112) (20, 20) frog + +-- makeImage :: Array arr cs e => (Int, Int) -> ((Int, Int) -> Pixel cs e) -> Image arr cs e + +-- ######## Convert to Luma ######### + +toPixelY :: Pixel cs e -> Pixel Y Double +toImageY :: (ToY cs e, Array arr cs e, Array arr Y Double) => + Image arr cs e + -> Image arr Y Double +toImageY = I.map toPixelY + +-- ####### Some trivial functions ######## +subtract :: Num x => (x, x) -> (x, x) -> (x, x) +subtract (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) + +dotProduct :: Num x => (x, x) -> (x, x) -> x +dotProduct (x1, y1) (x2, y2) = (x1 * x2) + (y1 * y2) + +magnitude :: Floating x => (x, x) -> x +magnitude x = sqrt (dotProduct x x) + +-- trying something new - Functor usage! +instance Functor P where + fmap f (x :| y) = f x :| f y + +fromIntegralP :: (Integral a, Num b) => P a -> P b +fromIntegralP = fmap fromIntegral + +-- ######## Hough-T function begins + +hough :: Image PixelRGB8 -> Int -> Int -> Image PixelRGB8 +hough image thetaSize distSize = hImage + where + widthMax = (imageWidth image) - 1 + heightMax = (imageHeight image) - 1 + xCtr = widthMax / 2 + yCtr = heightMax / 2 + lumaImg = toPixelY image +{- or let arr = arrLightIx2 Par (600 :. 800) {Generated image} // image + lumaImg = computeAs S $ fmap PixelY arr +-} + slope x y = + let orig = pixelAt lumaImg x y + x_ = pixelAt lumaImg (min (x + 1) widthMax) y + y_ = pixelAt lumaImg x (min (y + 1) heightMax) + in fromIntegralP (orig - x_, orig - y_) + -- List + slopeMap = [ ((x, y), slope x y) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] + + -- Type declaration + distMax :: Double + distMax = (sqrt . fromIntegral $ height ^ 2 + width ^ 2) / 2 + + minLineLength :: Int + minLineLength = 100 + + maxLineGap :: Int + maxLineGap = 10 + + + accBin = runST $ + do arr <- new ((0, 0), (thetaSize, distSize)) 0 + forM_ slopeMap $ \((x, y), gradient) -> do + let (x_, y_) = fromIntegralP ((xCtr, yCtr) `subtract` (x, y)) + when (magnitude gradient > 127) $ + forM_ [0 .. thetaSize] $ \theta -> do + let theta_ = + fromIntegral theta * 360 / fromIntegral thetaSize / 180 * + pi :: Double + distance = cos theta_ * x_ + sin theta_ * y_ + distance_ = round (distance * fromIntegral distSize )/ distMax + idx = (theta, distance_) + -- optimization possible + -- minLineLength = 100 (pixels) and maxLineGap = 10 (pixels) + when (distance_ >= 0 && distance_ < distSize) $ + do old <- read arr idx + write arr idx (old + 1) + return arr + + maxAcc = F.maximum accBin + -- Generating function + hTransform x y = + let l = 255 - round ((accBin ! (x, y)) / maxAcc * 255) + in PixelRGB8 l l l + hImage = makeImage hTransform thetaSize distSize + + +houghIO :: FilePath -> FilePath -> Int -> Int -> IO () +houghIO path outpath thetaSize distSize = do + +[path, path'] <- getArgs + eimg <- readImage path + case eimg of + Left err -> putStrLn ("Could not read image: " ++ err) + Right (ImageRGB8 image_) -> doImage image_ + Right (ImageRGBA8 image_) -> doImage $ pixelMap dropTransparency image_ + _ -> putStrLn "Unexpected Pixel Format" + where + doImage image = do + let houghImage = hough image thetaSize distSize + writeImage outpath $ ImageRGB8 houghImage + +{- ######### Helper functions ######### + transpose :: Array arr cs e => Image arr cs e -> Image arr cs e + index :: MArray arr cs e => Image arr cs e -> (Int, Int) -> Pixel cs e -- Pixel at ith, jth + dims :: BaseArray arr cs e => Image arr cs e -> (Int, Int) -- get dimensions of image + >>> frog <- readImageRGB VU "images/frog.jpg" + >>> frog + + >>> dims frog + (200,320) + + displayImage :: (Array VS cs e, Array arr cs e, Writable (Image VS cs e) TIF) => Image arr cs e -> IO () + writeImage :: (Array VS cs e, Array arr cs e, Writable (Image VS cs e) OutputFormat) => FilePath -> Image arr cs e -> IO () + + instance ToY RGB where + toPixelY (PixelRGB r g b) = PixelY (0.299*r + 0.587*g + 0.114*b) + + toImageBinary :: (Array arr cs e, Array arr Binary Bit, Eq (Pixel cs e)) => Image arr cs e -> Image arr Binary Bit + toImageBinary = I.map toPixelBinary + + makeImage :: Array arr cs e => (Int, Int) -> ((Int, Int) -> Pixel cs e) -> Image arr cs e -- Given generating function and dimensions + pixelAt :: Image a -> Int -> Int -> a + +-} + + +main :: IO () +main = do + args <- getArgs + prog <- getProgName + case args of + [path, outpath, thetaSize, distSize] -> + houghIO path outpath (read thetaSize) (read distSize) + _ -> + putStrLn $ + "Usage: " ++ prog ++ " " + + From c951886ddd88428c836ac4f73ed729e917f86f40 Mon Sep 17 00:00:00 2001 From: Khilan Ravani Date: Sat, 19 May 2018 16:51:58 +0530 Subject: [PATCH 2/7] Some trivial errors --- src/Graphics/Image/HoughTransform.hs | 120 ++++++++++++++------------- 1 file changed, 62 insertions(+), 58 deletions(-) diff --git a/src/Graphics/Image/HoughTransform.hs b/src/Graphics/Image/HoughTransform.hs index c59370a..c99a4a4 100644 --- a/src/Graphics/Image/HoughTransform.hs +++ b/src/Graphics/Image/HoughTransform.hs @@ -1,23 +1,26 @@ +{-# LANGUAGE FlexibleContexts #-} +module Graphics.Image.Processing.HoughTransform where + import Control.Applicative import System.Environment (getArgs, getProgName) import Control.Monad (forM_, when) import Control.Monad.ST import qualified Data.Foldable as F (maximum) -import Data.Massiv.Array.IO +-- import Data.Massiv.Array.IO import Data.List +import Data.Array.MArray -import Codec.Picture.Types(dropTransparency) -import Codec.Picture -import Prelude as P +import Prelude as P hiding (subtract) +import Graphics.Image.Processing.Filter +import Graphics.Image as GI import Graphics.Image.ColorSpace import Graphics.Image.IO import Graphics.Image.Interface as I import Graphics.Image.Types as IP - -- ######### Read Image ########## -readImageRGB :: Array arr RGB Double => arr -> FilePath -> IO (Image arr RGB Double) -readImageRGB _ = readImage' +-- readImageRGB :: Array arr RGB Double => arr -> FilePath -> IO (Image arr RGB Double) +-- readImageRGB _ = readImage' -- frog <- readImageRGB VU "images/frog.jpg" -- writeImage "images/frog_eye_grid.png" $ pixelGrid 10 $ crop (51, 112) (20, 20) frog @@ -26,7 +29,6 @@ readImageRGB _ = readImage' -- ######## Convert to Luma ######### -toPixelY :: Pixel cs e -> Pixel Y Double toImageY :: (ToY cs e, Array arr cs e, Array arr Y Double) => Image arr cs e -> Image arr Y Double @@ -39,89 +41,92 @@ subtract (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) dotProduct :: Num x => (x, x) -> (x, x) -> x dotProduct (x1, y1) (x2, y2) = (x1 * x2) + (y1 * y2) -magnitude :: Floating x => (x, x) -> x -magnitude x = sqrt (dotProduct x x) +mag :: Floating x => (x, x) -> x +mag x = sqrt (dotProduct x x) + +fromIntegralP :: (Integral x, Num y) => (x, x) -> (y, y) +fromIntegralP (x1, y1) = (fromIntegral x1, fromIntegral y1) +{- -- trying something new - Functor usage! instance Functor P where fmap f (x :| y) = f x :| f y fromIntegralP :: (Integral a, Num b) => P a -> P b fromIntegralP = fmap fromIntegral +-} -- ######## Hough-T function begins -hough :: Image PixelRGB8 -> Int -> Int -> Image PixelRGB8 +hough :: Image arr RGBA a -> Int -> Int -> Image arr RGBA a hough image thetaSize distSize = hImage where - widthMax = (imageWidth image) - 1 - heightMax = (imageHeight image) - 1 - xCtr = widthMax / 2 - yCtr = heightMax / 2 - lumaImg = toPixelY image + widthMax = (GI.rows image) - 1 + heightMax = (GI.cols image) - 1 + xCtr = widthMax / 2 + yCtr = heightMax / 2 + map = IP.toImageY image {- or let arr = arrLightIx2 Par (600 :. 800) {Generated image} // image lumaImg = computeAs S $ fmap PixelY arr -} - slope x y = - let orig = pixelAt lumaImg x y - x_ = pixelAt lumaImg (min (x + 1) widthMax) y - y_ = pixelAt lumaImg x (min (y + 1) heightMax) + slope x y = + let orig = I.read map x y + x_ = I.read map (min (x + 1) widthMax) y + y_ = I.read map x (min (y + 1) heightMax) in fromIntegralP (orig - x_, orig - y_) - -- List - slopeMap = [ ((x, y), slope x y) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] + -- List + slopeMap = [ ((x, y), slope (x, y)) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] - -- Type declaration - distMax :: Double - distMax = (sqrt . fromIntegral $ height ^ 2 + width ^ 2) / 2 - - minLineLength :: Int - minLineLength = 100 + -- Type declaration + distMax :: Double + distMax = (sqrt . fromIntegral $ (heightMax + 1) ^ 2 + (widthMax + 1) ^ 2) / 2 + + minLineLength :: Int + minLineLength = 100 - maxLineGap :: Int - maxLineGap = 10 + maxLineGap :: Int + maxLineGap = 10 - accBin = runST $ - do arr <- new ((0, 0), (thetaSize, distSize)) 0 + accBin = runST $ + do arr <- newArray ((0, 0), (thetaSize, distSize)) 0 forM_ slopeMap $ \((x, y), gradient) -> do let (x_, y_) = fromIntegralP ((xCtr, yCtr) `subtract` (x, y)) - when (magnitude gradient > 127) $ + when (mag gradient > 127) $ forM_ [0 .. thetaSize] $ \theta -> do let theta_ = fromIntegral theta * 360 / fromIntegral thetaSize / 180 * pi :: Double distance = cos theta_ * x_ + sin theta_ * y_ - distance_ = round (distance * fromIntegral distSize )/ distMax + fromIntegral distance_ = round (distance * fromIntegral distSize )/ distMax idx = (theta, distance_) -- optimization possible -- minLineLength = 100 (pixels) and maxLineGap = 10 (pixels) when (distance_ >= 0 && distance_ < distSize) $ - do old <- read arr idx - write arr idx (old + 1) + do old <- readArray arr idx + writeArray arr idx (old + 1) return arr - maxAcc = F.maximum accBin - -- Generating function - hTransform x y = + maxAcc = F.maximum accBin + -- Generating function + hTransform x y = let l = 255 - round ((accBin ! (x, y)) / maxAcc * 255) - in PixelRGB8 l l l - hImage = makeImage hTransform thetaSize distSize + in image l l l + hImage = makeImage thetaSize distSize hTransform houghIO :: FilePath -> FilePath -> Int -> Int -> IO () houghIO path outpath thetaSize distSize = do - -[path, path'] <- getArgs - eimg <- readImage path - case eimg of - Left err -> putStrLn ("Could not read image: " ++ err) - Right (ImageRGB8 image_) -> doImage image_ - Right (ImageRGBA8 image_) -> doImage $ pixelMap dropTransparency image_ - _ -> putStrLn "Unexpected Pixel Format" - where - doImage image = do - let houghImage = hough image thetaSize distSize - writeImage outpath $ ImageRGB8 houghImage + eimg <- readImage path + case eimg of + Left err -> putStrLn ("Could not read image: " ++ err) + Right image_ -> doImage image_ + _ -> putStrLn "Unexpected Pixel Format" + where + doImage :: Image VS RGBA Double -> IO () + doImage image = do + let houghImage = hough image thetaSize distSize + writeImage outpath houghImage {- ######### Helper functions ######### transpose :: Array arr cs e => Image arr cs e -> Image arr cs e @@ -147,16 +152,15 @@ houghIO path outpath thetaSize distSize = do -} - +{- main :: IO () main = do args <- getArgs prog <- getProgName - case args of + case args of [path, outpath, thetaSize, distSize] -> - houghIO path outpath (read thetaSize) (read distSize) + houghIO path outpath (P.read thetaSize) (P.read distSize) _ -> putStrLn $ "Usage: " ++ prog ++ " " - - +-} From 93f6d5bc0e8b91450c2fbcf8603d4caceb2df0d0 Mon Sep 17 00:00:00 2001 From: Khilan Ravani Date: Mon, 21 May 2018 15:01:26 +0530 Subject: [PATCH 3/7] Minor changes --- src/Graphics/Image/HoughTransform.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Graphics/Image/HoughTransform.hs b/src/Graphics/Image/HoughTransform.hs index c99a4a4..042f794 100644 --- a/src/Graphics/Image/HoughTransform.hs +++ b/src/Graphics/Image/HoughTransform.hs @@ -58,21 +58,21 @@ fromIntegralP = fmap fromIntegral -- ######## Hough-T function begins -hough :: Image arr RGBA a -> Int -> Int -> Image arr RGBA a +hough :: MImage a arr RGBA a -> Int -> Int -> Image arr RGBA a hough image thetaSize distSize = hImage where widthMax = (GI.rows image) - 1 heightMax = (GI.cols image) - 1 xCtr = widthMax / 2 yCtr = heightMax / 2 - map = IP.toImageY image + luma = IP.toImageY image {- or let arr = arrLightIx2 Par (600 :. 800) {Generated image} // image lumaImg = computeAs S $ fmap PixelY arr -} slope x y = - let orig = I.read map x y - x_ = I.read map (min (x + 1) widthMax) y - y_ = I.read map x (min (y + 1) heightMax) + let orig = I.read luma x y + x_ = I.read luma (min (x + 1) widthMax) y + y_ = I.read luma x (min (y + 1) heightMax) in fromIntegralP (orig - x_, orig - y_) -- List slopeMap = [ ((x, y), slope (x, y)) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] @@ -92,7 +92,7 @@ hough image thetaSize distSize = hImage do arr <- newArray ((0, 0), (thetaSize, distSize)) 0 forM_ slopeMap $ \((x, y), gradient) -> do let (x_, y_) = fromIntegralP ((xCtr, yCtr) `subtract` (x, y)) - when (mag gradient > 127) $ + when ((mag gradient) > 127) $ forM_ [0 .. thetaSize] $ \theta -> do let theta_ = fromIntegral theta * 360 / fromIntegral thetaSize / 180 * From 1ba65f9687ee058ca41d03a7ceac5928869f6708 Mon Sep 17 00:00:00 2001 From: Khilan Ravani Date: Mon, 21 May 2018 15:05:10 +0530 Subject: [PATCH 4/7] Update HoughTransform.hs --- src/Graphics/Image/HoughTransform.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Graphics/Image/HoughTransform.hs b/src/Graphics/Image/HoughTransform.hs index 042f794..84cd6e7 100644 --- a/src/Graphics/Image/HoughTransform.hs +++ b/src/Graphics/Image/HoughTransform.hs @@ -58,7 +58,7 @@ fromIntegralP = fmap fromIntegral -- ######## Hough-T function begins -hough :: MImage a arr RGBA a -> Int -> Int -> Image arr RGBA a +hough :: Image arr RGBA a -> Int -> Int -> Image arr RGBA a hough image thetaSize distSize = hImage where widthMax = (GI.rows image) - 1 From ba45f8f6e3ed96341e116627322acb3e5bdfc1c0 Mon Sep 17 00:00:00 2001 From: Khilan Ravani Date: Tue, 22 May 2018 13:16:34 +0530 Subject: [PATCH 5/7] Update HoughTransform.hs --- src/Graphics/Image/HoughTransform.hs | 31 ++++++++++++++-------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/src/Graphics/Image/HoughTransform.hs b/src/Graphics/Image/HoughTransform.hs index 84cd6e7..c94658a 100644 --- a/src/Graphics/Image/HoughTransform.hs +++ b/src/Graphics/Image/HoughTransform.hs @@ -65,17 +65,18 @@ hough image thetaSize distSize = hImage heightMax = (GI.cols image) - 1 xCtr = widthMax / 2 yCtr = heightMax / 2 - luma = IP.toImageY image -{- or let arr = arrLightIx2 Par (600 :. 800) {Generated image} // image - lumaImg = computeAs S $ fmap PixelY arr --} + --luma = IP.toImageY image + + arr = makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200) + luma = fmap PixelY arr + slope x y = - let orig = I.read luma x y - x_ = I.read luma (min (x + 1) widthMax) y - y_ = I.read luma x (min (y + 1) heightMax) + let orig = I.index luma (xCtr, yCtr) + x_ = I.index luma (widthMax,y) + y_ = I.index luma (x,heightMax) in fromIntegralP (orig - x_, orig - y_) -- List - slopeMap = [ ((x, y), slope (x, y)) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] + slopeMap = [ ((x, y), slope x y) | x <- [0 .. widthMax], y <- [0 .. heightMax] ] -- Type declaration distMax :: Double @@ -97,12 +98,12 @@ hough image thetaSize distSize = hImage let theta_ = fromIntegral theta * 360 / fromIntegral thetaSize / 180 * pi :: Double - distance = cos theta_ * x_ + sin theta_ * y_ - fromIntegral distance_ = round (distance * fromIntegral distSize )/ distMax - idx = (theta, distance_) + distance = round (cos theta_ * x_ + sin theta_ * y_) * ( distSize / fromIntegral distMax) + --fromIntegral distance_ = round (distance * fromIntegral distSize )/ distMax + idx = (theta, distance) -- optimization possible -- minLineLength = 100 (pixels) and maxLineGap = 10 (pixels) - when (distance_ >= 0 && distance_ < distSize) $ + when (distance>= 0 && distance < distSize) $ do old <- readArray arr idx writeArray arr idx (old + 1) return arr @@ -110,11 +111,10 @@ hough image thetaSize distSize = hImage maxAcc = F.maximum accBin -- Generating function hTransform x y = - let l = 255 - round ((accBin ! (x, y)) / maxAcc * 255) - in image l l l + let l = 255 - round ((I.index accBin (x, y)) /255 ) * maxAcc + in PixelRGBA l l l l hImage = makeImage thetaSize distSize hTransform - houghIO :: FilePath -> FilePath -> Int -> Int -> IO () houghIO path outpath thetaSize distSize = do eimg <- readImage path @@ -164,3 +164,4 @@ main = do putStrLn $ "Usage: " ++ prog ++ " " -} + From 409609540bc93bf8f6da0f7fdf8992ce208137f4 Mon Sep 17 00:00:00 2001 From: Khilan Ravani Date: Tue, 22 May 2018 14:31:41 +0530 Subject: [PATCH 6/7] Update HoughTransform.hs --- src/Graphics/Image/HoughTransform.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Graphics/Image/HoughTransform.hs b/src/Graphics/Image/HoughTransform.hs index c94658a..387d998 100644 --- a/src/Graphics/Image/HoughTransform.hs +++ b/src/Graphics/Image/HoughTransform.hs @@ -113,7 +113,7 @@ hough image thetaSize distSize = hImage hTransform x y = let l = 255 - round ((I.index accBin (x, y)) /255 ) * maxAcc in PixelRGBA l l l l - hImage = makeImage thetaSize distSize hTransform + hImage = makeImage (thetaSize, distSize) hTransform houghIO :: FilePath -> FilePath -> Int -> Int -> IO () houghIO path outpath thetaSize distSize = do From 9c659f88fdd4dba058dc3cb4b05888286a0b7d0e Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 22 May 2018 12:28:20 +0200 Subject: [PATCH 7/7] new Hough module --- src/Graphics/Image/Processing/Hough.hs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 src/Graphics/Image/Processing/Hough.hs diff --git a/src/Graphics/Image/Processing/Hough.hs b/src/Graphics/Image/Processing/Hough.hs new file mode 100644 index 0000000..e6e2a88 --- /dev/null +++ b/src/Graphics/Image/Processing/Hough.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +module Graphics.Image.Processing.Hough where + +import Graphics.Image +import Graphics.Image.ColorSpace +import Graphics.Image.Interface as I + +toImageY :: (ToY cs e, Array arr cs e, Array arr Y Double) => + Image arr cs e + -> Image arr Y Double +toImageY = I.map toPixelY + +-- ####### Some trivial functions ######## +sub :: Num x => (x, x) -> (x, x) -> (x, x) +sub (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) + +dotProduct :: Num x => (x, x) -> (x, x) -> x +dotProduct (x1, y1) (x2, y2) = (x1 * x2) + (y1 * y2) + +mag :: Floating x => (x, x) -> x +mag x = sqrt (dotProduct x x) + +fromIntegralP :: (Integral x, Num y) => (x, x) -> (y, y) +fromIntegralP (x1, y1) = (fromIntegral x1, fromIntegral y1)