This repository was archived by the owner on Jul 24, 2023. It is now read-only.
- Notifications
You must be signed in to change notification settings - Fork 0
This repository was archived by the owner on Jul 24, 2023. It is now read-only.
Paint fill function for an image #3
Copy link
Copy link
Open
Description
This is the paint-fill function. @balacij
algorithm-design-with-haskell/src/Recursion.hs
Lines 372 to 499 in b3f39e5
| {- | |
| 8.10 | |
| Implement the "paint fill" function that one might see on many image | |
| editing programs. That is, given a screen (represented by a | |
| two-dimensional array of colors), a point, and a new color, fill in | |
| the surrounding area until the color changes from the original color. | |
| test case: fillUpColor image (0,0) Blue | |
| original image: | |
| [ | |
| [Red,Red,Red], | |
| [Red,Yellow,Red], | |
| [Yellow,Yellow,Blue] | |
| ] | |
| expect image: | |
| [ | |
| [Blue,Blue,Blue], | |
| [Blue,Yellow,Blue], | |
| [Yellow,Yellow,Blue] | |
| ] | |
| -} | |
| data Color = Red | Yellow | Blue deriving Show | |
| instance Eq Color where | |
| Red == Red = True | |
| Red == Yellow = False | |
| Red == Blue = False | |
| Yellow == Yellow = True | |
| Yellow == Blue = False | |
| Yellow == Red = False | |
| Blue == Blue = True | |
| Blue == Yellow = False | |
| Blue == Red = False | |
| data Direction = Up | Down | PLeft | PRight | |
| type Image = V.Vector (V.Vector Color) | |
| -- test case | |
| image :: Image | |
| image = V.fromList | |
| [ | |
| V.fromList [Red, Red, Red], | |
| V.fromList [Red, Yellow, Red], | |
| V.fromList [Yellow, Yellow, Blue] | |
| ] | |
| -- fill up a color | |
| fillUpColor :: Image -> (Int, Int) -> Color -> Image | |
| fillUpColor img (i,j) c = foldl (\acc x -> paint acc x c ) img pList | |
| where pList = findArea img (i,j) | |
| -- Paint a color in one location | |
| paint :: Image -> (Int, Int) -> Color -> Image | |
| paint vs (i,j) c = | |
| fstHVects V.++ V.fromList[newPaintRow] V.++ V.drop 1 secHVects | |
| where | |
| (fstHVects, secHVects) = V.splitAt i vs | |
| (fstHPaintRow, secHPaintRow) = V.splitAt j (vs V.! i) | |
| newPaintRow = | |
| fstHPaintRow V.++ V.fromList[c] V.++ V.drop 1 secHPaintRow | |
| -- Find all locations which need to paint | |
| findArea :: Image -> (Int, Int) -> [(Int, Int)] | |
| findArea img (i,j) = uniq ( | |
| (i,j): | |
| findAreaOnDir img (i,j) boundC Up ++ | |
| findAreaOnDir img (i,j) boundC Down ++ | |
| findAreaOnDir img (i,j) boundC PLeft ++ | |
| findAreaOnDir img (i,j) boundC PRight) [] | |
| where boundC = img V.! i V.! j | |
| -- remove duplicates | |
| uniq :: [(Int, Int)] -> [(Int, Int)]-> [(Int, Int)] | |
| uniq [] buf = buf | |
| uniq (x:xs) buf | |
| | x `elem` buf = uniq xs buf | |
| | otherwise = uniq xs (x:buf) | |
| -- find potential position by direction | |
| findAreaOnDir :: Image -> (Int, Int) -> Color -> Direction -> [(Int, Int)] | |
| findAreaOnDir img (i,j) c Up | |
| | isInBoundAndSameColor img (i,j-1) c = | |
| (i,j-1): findAreaOnDir img (i,j-1) c PLeft | |
| | isInBoundAndSameColor img (i-1,j) c = | |
| (i-1,j): findAreaOnDir img (i-1,j) c Up | |
| | isInBoundAndSameColor img (i,j+1) c = | |
| (i,j+1): findAreaOnDir img (i,j+1) c PRight | |
| | otherwise = [] | |
| findAreaOnDir img (i,j) c Down | |
| | isInBoundAndSameColor img (i,j-1) c = | |
| (i,j-1): findAreaOnDir img (i,j-1) c PLeft | |
| | isInBoundAndSameColor img (i+1,j) c = | |
| (i+1,j): findAreaOnDir img (i+1,j) c Down | |
| | isInBoundAndSameColor img (i,j+1) c = | |
| (i,j+1): findAreaOnDir img (i,j+1) c PRight | |
| | otherwise = [] | |
| findAreaOnDir img (i,j) c PLeft | |
| | isInBoundAndSameColor img (i-1,j) c = | |
| (i-1,j): findAreaOnDir img (i-1,j) c Up | |
| | isInBoundAndSameColor img (i,j-1) c = | |
| (i,j-1): findAreaOnDir img (i,j-1) c PLeft | |
| | isInBoundAndSameColor img (i+1,j) c = | |
| (i+1,j): findAreaOnDir img (i+1,j) c Down | |
| | otherwise = [] | |
| findAreaOnDir img (i,j) c PRight | |
| | isInBoundAndSameColor img (i-1,j) c = | |
| (i-1,j): findAreaOnDir img (i-1,j) c Up | |
| | isInBoundAndSameColor img (i,j+1) c = | |
| (i,j+1): findAreaOnDir img (i,j+1) c PRight | |
| | isInBoundAndSameColor img (i+1,j) c = | |
| (i+1,j): findAreaOnDir img (i+1,j) c Down | |
| | otherwise = [] | |
| -- condition determine potential fill up position | |
| isInBoundAndSameColor :: Image -> (Int, Int) -> Color -> Bool | |
| isInBoundAndSameColor img (i,j) c = isInBound img (i,j) && selectC == c | |
| where selectC = img V.! i V.! j | |
| -- check if position if in bound | |
| isInBound :: Image -> (Int, Int) -> Bool | |
| isInBound img (i,j) | |
| | (0 <= i && i < xBound) && (0 <= j && j < yBound) = True | |
| | otherwise = False | |
| where xBound = length img | |
| yBound = length $ img V.! 0 |
Let me know what you think. I think there should be a way to simplify the findAreaOnDir method. It looks very cumbersome.
Metadata
Metadata
Assignees
Labels
No labels