Haskell Quiz/Maximum Sub-Array/Solution Jkramar
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
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