Haskell Quiz/Maximum SubArray/Solution Jkramar
From HaskellWiki
< Haskell Quiz  Maximum SubArray(Difference between revisions)
m 

Line 1:  Line 1:  
[[Category:Haskell Quiz solutionsMaximum SubArray]] 
[[Category:Haskell Quiz solutionsMaximum SubArray]] 

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

<haskell> 
<haskell> 

−  maxSubArray :: (Num a, Ord a) => [a] > [a] 
+  import Data.List 
−  maxSubArray xs = drop from$take to xs where 
+  
+  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..] 
sumswithpos = zip (scanl (+) 0 xs) [0..] 

−  diff ((a,ai),(b,bi)) = (ab,(bi,ai)) 
+  diff (a,ai) (b,bi) = (ab,(ai,bi)) 
−  (from,to) = snd$maximum$map diff$zip sumswithpos$scanl1 min sumswithpos 
+  
+  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> 
</haskell> 
Revision as of 23:16, 19 November 2008
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) = (ab,(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