Hough transform: Difference between revisions
Content deleted Content added
=={{header|Racket}}== block added |
Add Haskell - Hough Transform |
||
Line 182: | Line 182: | ||
} |
} |
||
}</lang> |
}</lang> |
||
=={{header|Haskell}}== |
|||
{{libheader|JuicyPixels}} |
|||
<lang Haskell>import Control.Monad (forM_, when) |
|||
import Data.Array ((!)) |
|||
import Data.Array.ST (newArray, writeArray, readArray, runSTArray) |
|||
import qualified Data.Foldable as F (maximum) |
|||
import System.Environment (getArgs, getProgName) |
|||
-- Library JuicyPixels: |
|||
import Codec.Picture (DynamicImage(ImageRGB8, ImageRGBA8), Image, |
|||
PixelRGB8(PixelRGB8), PixelRGBA8(PixelRGBA8), |
|||
imageWidth, imageHeight, pixelAt, generateImage, |
|||
readImage, pixelMap, savePngImage) |
|||
import Codec.Picture.Types (extractLumaPlane, dropTransparency) |
|||
dot :: Num a => (a, a) -> (a, a) -> a |
|||
dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2 |
|||
mag :: Floating a => (a, a) -> a |
|||
mag a = sqrt $ dot a a |
|||
sub :: Num a => (a, a) -> (a, a) -> (a, a) |
|||
sub (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) |
|||
fromIntegralP :: (Integral a, Num b) => (a, a) -> (b, b) |
|||
fromIntegralP (x, y) = (fromIntegral x, fromIntegral y) |
|||
{- |
|||
Create a Hough space image with y+ measuring the distance from |
|||
the center of the input image on the range of 0 to half the hypotenuse |
|||
and x+ measuring from [0, 2 * pi]. |
|||
The origin is in the upper left, so y is increasing down. |
|||
The image is scaled according to thetaSize and distSize. |
|||
-} |
|||
hough :: Image PixelRGB8 -> Int -> Int -> Image PixelRGB8 |
|||
hough image thetaSize distSize = hImage |
|||
where |
|||
width = imageWidth image |
|||
height = imageHeight image |
|||
wMax = width - 1 |
|||
hMax = height - 1 |
|||
xCenter = wMax `div` 2 |
|||
yCenter = hMax `div` 2 |
|||
lumaMap = extractLumaPlane image |
|||
gradient x y = |
|||
let orig = pixelAt lumaMap x y |
|||
x' = pixelAt lumaMap (min (x + 1) wMax) y |
|||
y' = pixelAt lumaMap x (min (y + 1) hMax) |
|||
in fromIntegralP (orig - x', orig - y') |
|||
gradMap = [((x, y), gradient x y) | x <- [0..wMax], y <- [0..hMax]] |
|||
-- The longest distance from the center, half the hypotenuse of the image. |
|||
distMax :: Double |
|||
distMax = (sqrt . fromIntegral $ height ^ 2 + width ^ 2) / 2 |
|||
{- |
|||
The accumulation bins of the polar values. |
|||
For each value in the gradient image, if the gradient length exceeds |
|||
some threshold, consider it evidence of a line and plot all of the |
|||
lines that go through that point in Hough space. |
|||
-} |
|||
accBin = runSTArray $ do |
|||
arr <- newArray ((0, 0), (thetaSize, distSize)) 0 |
|||
forM_ gradMap $ \((x, y), grad) -> do |
|||
let (x', y') = fromIntegralP $ (xCenter, yCenter) `sub` (x, y) |
|||
when (mag grad > 127) $ |
|||
forM_ [0..thetaSize] $ \theta -> do |
|||
let theta' = (fromIntegral theta) * 360 / (fromIntegral thetaSize) |
|||
/ 180 * pi :: Double |
|||
dist = (cos theta' * x' + sin theta' * y') |
|||
dist' = truncate $ dist * (fromIntegral distSize) / distMax |
|||
idx = (theta, dist') |
|||
when (dist' >= 0 && dist' < distSize) $ do |
|||
old <- readArray arr idx |
|||
writeArray arr idx $ old + 1 |
|||
return arr |
|||
maxAcc = F.maximum accBin |
|||
-- The image representation of the accumulation bins. |
|||
hTransform x y = |
|||
let l = 255 - (truncate $ (accBin ! (x, y)) / maxAcc * 255) |
|||
in PixelRGB8 l l l |
|||
hImage = generateImage hTransform thetaSize distSize |
|||
houghIO :: FilePath -> FilePath -> Int -> Int -> IO () |
|||
houghIO path outpath thetaSize distSize = do |
|||
image <- readImage path |
|||
case image of |
|||
Left err -> putStrLn err |
|||
Right (ImageRGB8 image') -> doImage image' |
|||
Right (ImageRGBA8 image') -> doImage $ pixelMap dropTransparency image' |
|||
_ -> putStrLn $ "Expecting RGB8 or RGBA8 image" |
|||
where |
|||
doImage image = do |
|||
let houghImage = hough image thetaSize distSize |
|||
savePngImage outpath $ ImageRGB8 houghImage |
|||
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 ++ " <image-file> <out-file.png> <width> <height>"</lang> |
|||
'''Example use:''' |
|||
<lang>HoughTransform Pentagon.png hough.png 360 360</lang> |
|||
[[Image:hough_haskell.png]] |
|||
=={{header|J}}== |
=={{header|J}}== |