Maximal positive submatrices using haskell - list

Question

I have following problem:
You are given matrix m*n and you have to find maximal positive ( all elements of submatrix should be > 0) submatrices from (1,1) to (x,y).
What do I mean by maximal is, when you have following matrix:
[[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
then maximal positive submatrices are:
[[[1,2,3,4],[5,6,7,8]],[[1,2],[5,6],[9,10],[13,14]]]
i.e. first two rows is one solution and first two columns is second solution.
Another example: matrix is
[[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
and solution is:
[[[1,2,3],[5,6,7]]]
This is my Haskell program which solves it:
import Data.List hiding (insert)
import qualified Data.Set as Set
unique :: Ord a => [a] -> [a]
unique = Set.toList . Set.fromList
subList::[[Int]] ->[[[Int]]]
subList matrix = filter (allPositiveMatrix) $ [ (submatrix matrix 1 1 x y) | x<-[1..width(matrix)], y<-[1..height(matrix)]]
maxWidthMat::[[[Int]]] -> Int
maxWidthMat subList =length ((foldl (\largestPreviousX nextMatrix -> if (length (nextMatrix!!0)) >(length (largestPreviousX !!0)) then nextMatrix else largestPreviousX ) [[]] subList)!!0)
maxWidthSubmatrices:: [[[Int]]] -> Int ->[[[Int]]]
maxWidthSubmatrices subList maxWidth = filter (\x -> (length $x!!0)==maxWidth) subList
height matrix = length matrix
width matrix = length (matrix!!0)
maximalPositiveSubmatrices matrix = maxWidthSubmatrices (subList matrix) (maxWidthMat (filter (\x -> (length $x!!0)==( maxWidthMat $ subList matrix )) (subList matrix)))
allPositiveList list = foldl (\x y -> if (y>0)&&(x==True) then True else False) True list
allPositiveMatrix:: [[Int]] -> Bool
allPositiveMatrix matrix = foldl (\ x y -> if (allPositiveList y)&&(x==True) then True else False ) True matrix
submatrix matrix x1 y1 x2 y2 = slice ( map (\x -> slice x x1 x2) matrix) y1 y2
slice list x y = drop (x-1) (take y list)
maximalWidthSubmatrix mm = maximum $ maximalPositiveSubmatrices mm
maximalHeigthSubmatrix mm = transpose $ maximum $ maximalPositiveSubmatrices $ transpose mm
-- solution
solution matrix =unique $ [maximalWidthSubmatrix matrix]++[maximalHeigthSubmatrix matrix]
As you can see it's extremely lengthy and ugly.
It problably isn't fastest too.
Could you show me more elegant, faster and shorter solution ( possibly with explantions) ?

Answer 1

Proposed algorithm
I think that in order to solve the problem, we first better perform a dimension reduction:
reduce_dim :: (Num a,Ord a) => [[a]] -> [Int]
reduce_dim = map (length . takeWhile (>0)) -- O(m*n)
Here for every row, we calculate the number of items - starting from the left - that are positive. So for the given matrix:
1 2 3 4 | 4
5 6 7 8 | 4
9 10 -11 12 | 2
13 14 15 16 | 4
The second row thus maps to 2, since the third element is -11.
Or for your other matrix:
1 2 3 -4 | 3
5 6 7 8 | 4
-9 10 -11 12 | 0
13 14 15 16 | 4
Since the first row has a -4 at column 4, and the third one at column 1.
Now we can obtain a scanl1 min over these rows:
Prelude> scanl1 min [4,4,2,4] -- O(m)
[4,4,2,2]
Prelude> scanl1 min [3,4,0,4] -- O(m)
[3,3,0,0]
Now each time the number decreases (and at the end), we know we have found a maximal submatrix at the row above. Since that means we now work with a row from where on, the number of columns is less. Once we reach zero, we know that further evaluation has no sense, since we are working with a matrix with 0 columns.
So based on that list, we can simply generate a list of tuples of the sizes of the maximal submatrices:
max_sub_dim :: [Int] -> [(Int,Int)]
max_sub_dim = msd 1 -- O(m)
where msd r [] = []
msd r (0:_) = []
msd r [c] = [(r,c)]
msd r (c1:cs#(c2:_)) | c2 < c1 = (r,c1) : msd (r+1) cs
| otherwise = msd (r+1) cs
So for your two matrices, we obtain:
*Main> max_sub_dim $ scanl1 min $ reduce_dim [[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
[(2,4),(4,2)]
*Main> max_sub_dim $ scanl1 min $ reduce_dim [[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
[(2,3)]
Now we only need to obtain these submatrices themselves. We can do this by using take and a map over take:
construct_sub :: [[a]] -> [(Int,Int)] -> [[[a]]]
construct_sub mat = map (\(r,c) -> take r (map (take c) mat)) -- O(m^2*n)
And now we only need to link it all together in a solve:
-- complete program
reduce_dim :: (Num a,Ord a) => [[a]] -> [Int]
reduce_dim = map (length . takeWhile (>0))
max_sub_dim :: [Int] -> [(Int,Int)]
max_sub_dim = msd 1
where msd r [] = []
msd r (0:_) = []
msd r [c] = [(r,c)]
msd r (c1:cs#(c2:_)) | c2 < c1 = (r,c1) : msd (r+1) cs
| otherwise = msd (r+1) cs
construct_sub :: [[a]] -> [(Int,Int)] -> [[[a]]]
construct_sub mat = map (\(r,c) -> take r (map (take c) mat))
solve :: (Num a,Ord a) => [[a]] -> [[[a]]]
solve mat = construct_sub mat $ max_sub_dim $ scanl1 min $ reduce_dim mat
Which then generates:
*Main> solve [[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
[[[1,2,3,4],[5,6,7,8]],[[1,2],[5,6],[9,10],[13,14]]]
*Main> solve [[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
[[[1,2,3],[5,6,7]]]
Time complexity
The algorithm runs in O(m×n) with m the number of rows and n the number of columns, to construct the dimensions of the matrices. For every defined function, I wrote the time complexity in comment.
It will take O(m2×n) to construct all submatrices. So the algorithm runs in O(m2×n).
We can transpose the approach and run on columns instead of rows. So in case we are working with matrices where the number of rows differs greatly from the number of columns, we can first calculate the minimum, optionally transpose, and thus make m the smallest of the two.
Point of potential optimization
we can make the algorithm faster by constructing submatrices while constructing max_sub_dim saving some work.