Column Minima in a totally monotone matrix
Let type Matrix a = Int->Int->a to denote a matrix. $A=\{a_{i,j}\}$ for $1\leq i\leq n, 1\leq j\leq m$ is a totally monotone matrix is if for all $i < i'$ and $j < j'$, we have $a_{i,j} > a_{i',j} \Rightarrow a_{i,j'} > a_{i',j'}$. We want an algorithm that uses $O(n+m)$ evaluation of the entries of the matrix to find out the row position of each column's minima.
The SMAWK algorithm solves this problem. Here is an video which features the algorithm around 37 minutes into the video. David Eppstein have a python implementation of the algorithm.
Implement columnMinima :: Ord a => Matrix a->Int->Int->[Int], which takes a totally monotone matrix with it's width and height, it find the list of column minima's row position.
Example
SMAWK.hs
module SMAWK (columnMinima) where -- matrix is totally monotone. matrix i j = (a!!i)!!j where a = [[8,5,5,13,53,68], [m,5,1,5,37,50], [m,m,5,1,17,26], [m,m,m,13,13,18], [m,m,m,m,53,50], [m,m,m,m,m,68]] m = 10000 ghci> columnMinima matrix 6 6 [0,0,1,2,3,3]
Solution
My solution is just a Haskell translation of Eppstein's code. It requires evenOddSplit and horizontalPath.
module SMAWK (columnMinima) where import qualified Data.IntMap as M import Data.Array
type Coord = M.IntMap Int type Matrix a = Int->Int->a columnMinima :: Ord a => Matrix a->Int->Int->[Int] columnMinima m w h = [(M.!) pos x|x<-[0..w-1]] where pos = smawk [0..h-1] [0..w-1] m -- Rows, Cols, Matrix, Maximum smawk :: Ord a => [Int]->[Int]->Matrix a ->Coord smawk rows cols m | null cols = M.empty | otherwise = interpolate row2 where row2 = reverse $ reduce rows [] minima = smawk row2 (snd $ evenOddSplit cols) m cols' = listArray (0,n-1) cols n = length cols -- the reduce part reduce :: [Int]->[Int]->[Int] reduce xs ys -- ys is stack | null xs = ys | null ys = cont | m y ci > m x ci = reduce xs (tail ys) | t /= n = cont | otherwise = reduce (tail xs) ys where x = head xs y = head ys ci = cols'!(t-1) cont = reduce (tail xs) (x:ys) t = length ys interpolate :: [Int]->Coord interpolate rows = M.fromList (map f broken) `M.union` minima where broken = zip (fst $ evenOddSplit cols) (horizontalPath rows ([head rows]++[M.findWithDefault (last rows) (cols'!(c+1)) minima | c<-[0,2..n-2]]++[last rows])) f (a,b) = (a, snd $ minimum $ map g b) where g i = (m i a, i)