# Haskell Quiz/Maximum Sub-Array/Solution Jkramar

### From HaskellWiki

< Haskell Quiz | Maximum Sub-Array(Difference between revisions)

m |
|||

(4 intermediate revisions by one user not shown) | |||

Line 1: | Line 1: | ||

[[Category:Haskell Quiz solutions|Maximum Sub-Array]] |
[[Category:Haskell Quiz solutions|Maximum Sub-Array]] |
||

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

+ | <haskell> |
||

+ | 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 |
||

+ | </haskell> |
||

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

<haskell> |
<haskell> |
||

− | maxSubArray xs = drop from$take to xs where |
+ | import Data.Monoid |

− | sums = zip (scanl (+) 0 xs) [0..] |
+ | import Data.Function (on) |

− | diff ((a,ai),(b,bi)) = (a-b,(bi,ai)) |
+ | import Data.List |

− | (from,to) = snd$maximum$map diff$zip sums$scanl1 min sums |
+ | 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 |
||

</haskell> |
</haskell> |

## Latest revision as of 18:47, 21 February 2010

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