Paint fill function for an image

[cd155]

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.

[cd155]

I made a better version for the fill-up painting function. @balacij

https://github.com/cd155/haskell-leetcode/blob/318932061f78ee5ecfccef00c33def5e88ae00a1/main/WeekOne.hs#L329-L399

[balacij]

Looks much better! 😄

Are you able to do it row-wise instead of point-wise out of curiosity?

[cd155]

Looks much better! smile

Are you able to do it row-wise instead of point-wise out of curiosity?

@balacij I actually not sure how to this question row-wise. The current way is to find all the coordinates of possible points that need to be painted. Once find all of them, then paint them accordingly.

[cd155]

The ideology of row-wise seems very interesting. Thanks for pointing it out. It's doable, and I will keep you in the post.

[balacij]

It was just a thought on how an algorithm could be done if you know the ranges of the "insides" of the shape by length along the horizontal axis. I hope it works 😄