# Haskell Quiz/Maximum Sub-Array/Solution Jkramar

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

This includes a solution to the "extra credit" problem of finding the maximum subrectangle.

```import Data.List

maxSubArray' :: (Ord a, Num a) => [a] -> (a, (Int, Int))
maxSubArray' xs = maximum\$zipWith diff sumswithpos\$scanl1 min sumswithpos where
sumswithpos = zip (scanl (+) 0 xs) [0..]
diff (a,ai) (b,bi) = (a-b,(ai,bi))

maxSubArray :: (Ord a, Num a) => [a] -> [a]
maxSubArray xs = drop from\$take to xs where (_, (to, from)) = maxSubArray' xs

maxSubRect' :: (Ord a, Num a) => [[a]] -> ((a, (Int, Int)), (Int, Int))
maxSubRect' as = maximum rectsums where
sums ((c,b):rs) = [(maxSubArray'\$zipWith (-) b' b, (c',c))|(c',b') <- rs]
rectsums = concatMap sums\$init\$tails\$zip [0..]\$transpose\$map (scanl (+) 0) as

maxSubRect :: (Ord a, Num a) => [[a]] -> [[a]]
maxSubRect as = map (drop y1.take y2)\$drop x1\$take x2 as where
((_,(x2,x1)),(y2,y1)) = maxSubRect' as
```

And now with a gratuitous monad, which actually ends up decreasing the type-safety:

```import Data.Monoid
import Data.Function (on)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Ord (comparing)

data TakeNote n a = TakeNote !n !a deriving (Show, Read)
note (TakeNote n _) = n
dropNote (TakeNote _ a) = a
instance (Eq a) => Eq (TakeNote n a) where (==) = (==) `on` dropNote
instance (Ord a) => Ord (TakeNote n a) where compare = comparing dropNote
instance (Monoid n) => Monad (TakeNote n) where
return = TakeNote mempty
TakeNote n a >>= f = TakeNote (mappend n m) b where TakeNote m b = f a
instance Functor (TakeNote n) where fmap f (TakeNote n a) = TakeNote n\$f a
instance (Monoid n) => Applicative (TakeNote n) where pure = return; (<*>) = ap

number :: [a] -> [TakeNote [Int] a]
number = zipWith TakeNote (pure<\$>[0..])

psum :: (Num a) => [a] -> [a]
psum = scanl (+) 0

maxSubArray' :: (Ord a, Num a) => [a] -> TakeNote [Int] a
maxSubArray' xs = maximum\$zipWith (liftA2 (-)) psums\$scanl1 min psums where
psums = number\$psum xs

maxSubArray' :: (Ord a, Num a) => [a] -> [a]
maxSubArray xs = drop from\$take to xs where [to, from] = note\$maxSubArray' xs

maxSubRect' :: (Ord a, Num a) => [[a]] -> TakeNote [Int] a
maxSubRect' as = maximum\$concatMap sums\$tails\$number\$transpose\$psum<\$>as where
sums (r:rs) = [maxSubArray'=<<liftA2 (zipWith (-)) r' r|r'<-rs]; sums [] = []

maxSubRect :: (Ord a, Num a) => [[a]] -> [[a]]
maxSubRect as = map (drop y1.take y2)\$drop x1\$take x2 as where
[y2,y1,x2,x1] = note\$maxSubRect' as
```