Maximum Size Square of All 1's in Haskell

Question

if I have a matrix

m = 0 0 1 1 0
    0 1 1 1 0
    1 0 1 1 1
    1 1 1 1 1
    0 1 1 1 1

How do I find the the largest nXn sub matrix of m that is just 1's? This seems an OK problem in an imperative language, and indeed there are answers to this on Stack overflow using other languages, but I don't know where to start with Haskell.

we can assume that m is represented by

m = [ [0, 0, 1, 1, 0]
    , [1, 1, 1, 0, 0]
    , [1, 0, 1, 1, 1]
    , [1, 1, 1, 1, 1]
    , [0, 1, 1, 1, 1]
    ]

if that helps. In this case the answer would the bottom right 3x3 sub matrix.

Answer 1

An optimal O(n^2) solution can be done using only lists and right folds ⁽¹⁾. I also generalize to maximum area sub-rectangle, not just squares. Limiting to only squares is an easy modification ⁽²⁾.

import Control.Monad (ap)
import Data.Ord (comparing)

data Rect = Rect {
    row    :: Int, -- lower left row index
    col    :: Int, -- lower left column index
    width  :: Int,
    height :: Int
    } deriving (Show, Eq)

instance Ord Rect where  -- compare on area
    compare = comparing $ \a -> width a * height a

The idea is that first, at each cell, count ones upwards until you hit a zero. For the example in the question this would be:

[0,0,1,1,0]       [0,0,1,1,0]
[1,1,1,0,0]       [1,1,2,0,0]
[1,0,1,1,1]  >>>  [2,0,3,1,1]
[1,1,1,1,1]       [3,1,4,2,2]
[0,1,1,1,1]       [0,2,5,3,3]

and can be done by a right fold:

count :: Foldable t => t [Int] -> [[Int]]
count = ($ repeat 0) . foldr go (const [])
    where
    go x f = ap (:) f . zipWith inc x
    inc 0 = const 0
    inc _ = succ

Then, interpreting each number as height of a building, each row reduces to a skyline problem:

Given height of buildings, find the largest rectangular banner which fits entirely under the skyline (i.e. outline of buildings).

For example, the skyline and the optimal rectangular banner in the last two rows would be as bellow (the banner is marked with #):

                            +
         +                  +
     +   +                  # # #
     +   # # #            + # # #
     + + # # #            + # # #
4th: 3 1 4 2 2     5th: 0 2 5 3 3

This problem can be solved in linear time for each row, by maintaining a stack (list) of buildings with increasing height. Whenever an item is popped out of the stack we update the current optimal solution:

solve :: Foldable t => t [Int] -> Rect
solve = maximum . zipWith run [0..] . count
    where
    run ri xs = maximum $ foldr go end xs 1 [(0, 0)]
        where
        end = go 0 $ \_ _ -> []
        go x f i ((_, y): r@((k, _):_))
            | x <= y = Rect ri k (i - k - 1) y: go x f i r
        go x f i y = f (i + 1) $ (i, x): y

then,

\> solve [[0,0,1,1,0],[1,1,1,0,0],[1,0,1,1,1]]
Rect {row = 2, col = 2, width = 3, height = 1}

\> solve [[0,0,1,1,0],[1,1,1,0,0],[1,0,1,1,1],[1,1,1,1,1]]
Rect {row = 3, col = 2, width = 3, height = 2}

\> solve [[0,0,1,1,0],[1,1,1,0,0],[1,0,1,1,1],[1,1,1,1,1],[0,1,1,1,1]]
Rect {row = 4, col = 2, width = 3, height = 3}

---

<sub>1. this is optimal because it is linear in the number of elements of the matrix and you cannot do better than linear here.
2. in order to limit to just squares, you only need to change the lambda used in compare function to: \a -> min (width a) (height a)</sub>

Answer 2

For examples of how to implement dynamic programming algorithms in Haskell, see this wiki page:

• Dynamic Programming in Haskell

Here is a simple example which solves the "Minimum Steps to One" problem described here. At an integer n you can move to n-1 or n/2 (if n is even) or n/3 if n is divisible by 3. Here is a solution using Haskell arrays:

import Data.Array

stepsToOne n = arr
  where arr = array (1,n) [
                 (i,e)
                   | i <- [1..n]
                   , let e  | i <= 1    = 0
                            | otherwise = 1 + minimum (sub1 ++ div2 ++ div3)
                              where sub1 = [ arr ! (i-1) ]
                                    div2 = if mod i 2 == 0 then [ arr ! (div i 2) ] else []
                                    div3 = if mod i 3 == 0 then [ arr ! (div i 3) ] else []
              ]

Update

Here is the same algorithm implemented using lists:

stepsToOne' n = arr
  where arr = [ e | i <- [0..n]
                  , let e | i <= 1 = 0
                            | otherwise = 1 + minimum (sub1 ++ div2 ++ div3)
                              where sub1 = [ arr !! (i-1) ]
                                    div2 = if mod i 2 == 0 then [ arr !! (div i 2) ] else []
                                    div3 = if mod i 3 == 0 then [ arr !! (div i 3) ] else []
              ]

test = stepsToOne' 10

Note how arr !! i references arr !! (i-1) and possibly arr !! (div i 2) and arr !! (div i 3). Haskell will figure out the order in which to evaluate the list items based on how they are related.

This is the same as writing:

stepsToOne' n = [ s0, s1, s2, s3, s4, s5, s6, ... ]
  where s0 = 0
        s1 = 0
        s2 = 1 + minimum [s1, s1]
        s3 = 1 + minimum [s2, s1]
        s4 = 1 + minimum [s3, s2]
        s5 = 1 + minimum [s4]
        ...