Haskell - pattern match over a 2D grid using a sliding window

Question

I'm trying to implement a function to match a specific pattern in Haskell inside a 2D grid. For example, if my grid is defined as follows:

grid = [[0,0,0,0],
        [0,1,1,0],
        [0,1,1,0],
        [0,0,0,0]] 

and the pattern I am looking for is:

pattern = [[1, 1], 
           [0, 0]]

I would like it to return the index of the top left element in the grid. In this case, (2,1). My function has the following type:

matches2d :: Eq a 
          => [[a]]          -- ^ The 2D grid to match over 
          -> [[a]]          -- ^ The 2D pattern to match
          -> [(Int, Int)]   -- ^ Top left corner of sections matching the pattern

I am not exactly sure how to approach this problem. The method I am trying to use here is a sliding window of the pattern over the grid, but I've been trying to implement something like that for a bit now. This is what I have so far, but I think I'm missing some of the logic behind it:

matches2d :: Eq a => [[a]] -> [[a]] -> [(Int, Int)] 
matches2d _ [] = [] 
matches2d f (x:xs) = matcher x pattern 
  where matcher x y (x:xs) = sort x == sort y

Thanks in advance for you help.

Answer 1

So the solution for this took me some time. I needed to define another helper function and a few others to get it to work. To boil it down there is a slicer function: which takes a full grid and two tuples then extracts the subgrid with the rows in the range of the first tuple and the columns of the second tuple. The definition for it is as follows:

slicer :: [[a]] -> (Int, Int) -> (Int, Int) -> [[a]]
slicer [] _ _ = []
slicer a (x1,x2) (y1,y2) =form (head ( [[index a (i,j)|i<-[x1..x2-1],j<-[y1..y2-1]]])) (x2-x1,y2-y1)

I also needed a function to return the value at a given index in the grid, index:

index :: [[a]] -> (Int, Int) -> a
index (b:bb) (0,0) = head b
index (c:cc) (0,y) = index [(tail c)] (0,y-1)
index (d:dd) (x,y) = index dd (x-1,y)

Next thing was to define that helper function. That took most of the work of the function. It helped to "nest" the operation over the entire grid. Its entire function is to slide the window with the fixed size all over the grid and find a match. Once it does, it gives the top left-most coordinates of that matching window. The definition for it is this:

helper :: Eq a => [[a]] -> [[a]] -> (Int, Int, Int) -> [(Int, Int)]
helper x _ (l, m, n) | (l > length x) = []
helper x y (l, m, n) | (n > length (concat (take 1 x))) = helper x y (l+1, 0, (length (concat (take 1 y))))
helper x y (l, m, n) | (slicer x (l, (length y) + l) (m, n) == y) = [(l, m)] ++ helper x y (l, (m+1), (n+1))
helper x y (l, m, n) | (slicer x (l, (length y) + l) (m, n) /= y) = [] ++ helper x y (l, (m+1), (n+1))

Finally, after all those sub-functions came time to actually make the function I was trying to make from the beginning. Ironically enough, it was the simplest of them as it just takes the given pattern over the length of the grid.

matcher :: Eq a => [[a]] -> [[a]] -> [(Int, Int)]
matcher x y = helper x y (0, 0, (length (concat (take 1 y))))

Answer 2

Solve it with recursion.

Here's some iterative development. In the following, you will need to have an understanding of list comprehensions and the zipWith function, first. It is the simplest function which solves the equation

zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys

or, if you're familiar with zip,

zipWith f xs ys = [f x y | (x,y) <- zip xs ys]

Also,

and (x:xs) = x && and xs
           =  all (\x -> x == True) xs
           =  all (\x -> x) xs
           =  all id xs

With that,

1.

matches2d_1 :: Eq a => [[a]] -> [[a]] -> Bool
matches2d_1 pattern xss = 
    and (map and (zipWith (zipWith (==)) pattern xss))     -- does it match?
    ||  matches2d_1 pattern (drop 1 xss)            -- or start at next row
    ||  matches2d_1 pattern (map (drop 1) xss)      -- or start at next column

This is wrong in edge cases, but gives a general idea. The core of it is the and (zipWith (\a b -> and (zipWith (==) a b)) pattern xss) bit.

Note that it only gives us the indication of the first successful result, but we want all of them, so, a list of them. Hence,

2.

matches2d_2 :: Eq a => [[a]] -> [[a]] -> [Bool]
matches2d_2 pattern xss    | shorter xss pattern       = []  -- not enough rows
matches2d_2 pattern (xs:_) | shorter xs (head pattern) = []  -- not enough columns
matches2d_2 pattern xss = 
    [True | and (map and (zipWith (zipWith (==)) pattern xss))]  -- this match
    ++  matches2d_2 pattern (drop 1 xss)            -- or other
    ++  matches2d_2 pattern (map (drop 1) xss)      --      ones...
shorter a b = -- length a < length b
       .... implement it better

This takes care of the edge cases, but instead of returning actual successful results it still just reports about each of them.

3.

matches2d :: Eq a => [[a]] -> [[a]] -> [(Int,Int)]
.....

Augmenting the above should give us the actual results that we want here.

4.

With working implementation following the specs, we can think about efficiency next. Does it do any redundant work, repeatedly? Can this be avoided?