Hough transform: Difference between revisions

Content added Content deleted
m (→‎{{header|J}}: Update for J8)
(→‎{{header|Haskell}}: Adjusted some names to avoid a wiki formatting glitch (+ hlint, hindent))
Line 198: Line 198:


-- Library JuicyPixels:
-- Library JuicyPixels:
import Codec.Picture (DynamicImage(ImageRGB8, ImageRGBA8), Image,
import Codec.Picture
PixelRGB8(PixelRGB8), PixelRGBA8(PixelRGBA8),
(DynamicImage(ImageRGB8, ImageRGBA8), Image, PixelRGB8(PixelRGB8),
imageWidth, imageHeight, pixelAt, generateImage,
PixelRGBA8(PixelRGBA8), imageWidth, imageHeight, pixelAt,
readImage, pixelMap, savePngImage)
generateImage, readImage, pixelMap, savePngImage)
import Codec.Picture.Types (extractLumaPlane, dropTransparency)
import Codec.Picture.Types (extractLumaPlane, dropTransparency)


dot
⚫
dot :: Num a => (a, a) -> (a, a) -> a
:: Num a
⚫
=> (a, a) -> (a, a) -> a
dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2
dot (x1, y1) (x2, y2) = x1 * x2 + y1 * y2


mag
⚫
mag :: Floating a => (a, a) -> a
:: Floating a
⚫
=> (a, a) -> a
mag a = sqrt $ dot a a
mag a = sqrt $ dot a a


sub
⚫
sub :: Num a => (a, a) -> (a, a) -> (a, a)
:: Num a
⚫
=> (a, a) -> (a, a) -> (a, a)
sub (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)
sub (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)


fromIntegralP :: (Integral a, Num b) => (a, a) -> (b, b)
fromIntegralP
:: (Integral a, Num b)
=> (a, a) -> (b, b)
fromIntegralP (x, y) = (fromIntegral x, fromIntegral y)
fromIntegralP (x, y) = (fromIntegral x, fromIntegral y)


Line 232: Line 240:
xCenter = wMax `div` 2
xCenter = wMax `div` 2
yCenter = hMax `div` 2
yCenter = hMax `div` 2
⚫
lumaMap = extractLumaPlane image
lumaMap = extractLumaPlane image
⚫
gradient x y =
gradient x y =
let orig = pixelAt lumaMap x y
let orig = pixelAt lumaMap x y
x' = pixelAt lumaMap (min (x + 1) wMax) y
x_ = pixelAt lumaMap (min (x + 1) wMax) y
y' = pixelAt lumaMap x (min (y + 1) hMax)
y_ = pixelAt lumaMap x (min (y + 1) hMax)
in fromIntegralP (orig - x', orig - y')
in fromIntegralP (orig - x_, orig - y_)
gradMap =
⚫
gradMap = [((x, y), gradient x y) | x <- [0..wMax], y <- [0..hMax]]
[ ((x, y), gradient x y)
| x <- [0 .. wMax]
, y <- [0 .. hMax] ]
-- The longest distance from the center, half the hypotenuse of the image.
-- The longest distance from the center, half the hypotenuse of the image.
distMax :: Double
distMax :: Double
distMax = (sqrt . fromIntegral $ height ^ 2 + width ^ 2) / 2
distMax = (sqrt . fromIntegral $ height ^ 2 + width ^ 2) / 2
{-
{-
The accumulation bins of the polar values.
The accumulation bins of the polar values.
Line 253: Line 259:
lines that go through that point in Hough space.
lines that go through that point in Hough space.
-}
-}
accBin = runSTArray $ do
accBin =
runSTArray $
arr <- newArray ((0, 0), (thetaSize, distSize)) 0
forM_ gradMap $ \((x, y), grad) -> do
do arr <- newArray ((0, 0), (thetaSize, distSize)) 0
forM_ gradMap $
⚫
let (x', y') = fromIntegralP $ (xCenter, yCenter) `sub` (x, y)
\((x, y), grad) -> do
⚫
let (x_, y_) = fromIntegralP $ (xCenter, yCenter) `sub` (x, y)
when (mag grad > 127) $
forM_ [0..thetaSize] $ \theta -> do
when (mag grad > 127) $
let theta' = (fromIntegral theta) * 360 / (fromIntegral thetaSize)
forM_ [0 .. thetaSize] $
/ 180 * pi :: Double
\theta -> do
dist = (cos theta' * x' + sin theta' * y')
let theta_ =
dist' = truncate $ dist * (fromIntegral distSize) / distMax
fromIntegral theta * 360 / fromIntegral thetaSize / 180 *
idx = (theta, dist')
pi :: Double
dist = cos theta_ * x_ + sin theta_ * y_
when (dist' >= 0 && dist' < distSize) $ do
dist_ = truncate $ dist * fromIntegral distSize / distMax
old <- readArray arr idx
idx = (theta, dist_)
writeArray arr idx $ old + 1
when (dist_ >= 0 && dist_ < distSize) $
⚫
do old <- readArray arr idx

⚫
writeArray arr idx $ old + 1
return arr
return arr
maxAcc = F.maximum accBin
maxAcc = F.maximum accBin

-- The image representation of the accumulation bins.
-- The image representation of the accumulation bins.
hTransform x y =
hTransform x y =
let l = 255 - (truncate $ (accBin ! (x, y)) / maxAcc * 255)
let l = 255 - truncate ((accBin ! (x, y)) / maxAcc * 255)
in PixelRGB8 l l l
in PixelRGB8 l l l
⚫
hImage = generateImage hTransform thetaSize distSize
hImage = generateImage hTransform thetaSize distSize


Line 285: Line 289:
image <- readImage path
image <- readImage path
case image of
case image of
Left err -> putStrLn err
Left err -> putStrLn err
Right (ImageRGB8 image') -> doImage image'
Right (ImageRGB8 image_) -> doImage image_
Right (ImageRGBA8 image') -> doImage $ pixelMap dropTransparency image'
Right (ImageRGBA8 image_) -> doImage $ pixelMap dropTransparency image_
_ -> putStrLn $ "Expecting RGB8 or RGBA8 image"
_ -> putStrLn "Expecting RGB8 or RGBA8 image"
where
where
doImage image = do
doImage image = do
Line 301: Line 305:
[path, outpath, thetaSize, distSize] ->
[path, outpath, thetaSize, distSize] ->
houghIO path outpath (read thetaSize) (read distSize)
houghIO path outpath (read thetaSize) (read distSize)
⚫
_ ->
⚫
_ -> putStrLn $ "Usage: " ++ prog ++ " <image-file> <out-file.png> <width> <height>"</lang>
⚫
putStrLn $
⚫
"Usage: " ++ prog ++ " <image-file> <out-file.png> <width> <height>"</lang>
'''Example use:'''
'''Example use:'''
<lang>HoughTransform Pentagon.png hough.png 360 360</lang>
<lang>HoughTransform Pentagon.png hough.png 360 360</lang>
Retrieved from "https://rosettacode.org/wiki/Hough_transform"