The Haskell Program: mss1.hs

  1 import Data.List (inits, tails)
  2 
  3 -- Reading
  4 -- "Programming Pearls" by Jon Bentley
  5 -- "Pearls of Functional Algorithm Design" by Richard Bird
  6 -- http://wordaligned.org/articles/the-maximum-subsequence-problem
  7 -- http://www.codemanic.com/papers/papers/maxsum/MaxSum.pdf
  8 
  9 
 10 -- sum :: (Num a) => [a] -> a
 11 -- sum = foldl (+) 0
 12 
 13 -- maximum :: (Ord a) => [a] -> a
 14 -- maximum [] = error "maximum"
 15 -- maximum xs = fold1 max xs
 16 
 17 -- (strictMaximum uses foldl')
 18 
 19 -- tails :: [a] -> [[a]]
 20 -- tails:  http://www.haskell.org/ghc/docs/latest/html/libraries/base/src/Data-List.html#tails
 21 -- tails [1,2,3] = [[1,2,3],[2,3],[3],[]]
 22 
 23 -- inits :: [a] -> [[a]]
 24 -- inits: http://www.haskell.org/ghc/docs/latest/html/libraries/base/src/Data-List.html#tails
 25 -- inits [1,2,3] = [[],[1],[1,2],[1,2,3]]
 26 
 27 -- subsequences :: [a] -> [[a]]
 28 -- subsequences : http://www.haskell.org/ghc/docs/latest/html/libraries/base/src/Data-List.html#subsequences
 29 -- subsequences [1,2,3] = [[], [1], [2], [3], [1,2], [2,3], [1,3], [1,2,3]]
 30 -- NB.  Not *consecutive*.
 31 
 32 -- all consecutive subsequences (with annoying but ignornable multiple [])
 33 --       concat (map inits (tails xs))
 34 -- all consecutive subsequences (with no [])
 35 --       concat (map tail.inits (tails xs))
 36 
 37 consecutiveSubSeq :: [a] -> [[a]]
 38 consecutiveSubSeq = ([]:) . concatMap (tail . inits) . tails
 39 
 40 partialSum :: (Num a) => [a] -> [a]
 41 partialSum = (map sum) . inits
 42 
 43 maxSum1 :: (Ord a, Num a) => [a] -> a
 44 maxSum1 xs = maximum (map sum (consecutiveSubSeq xs))
 45 
 46 -- alternative
 47 maxSum1' = maximumBy (comparing sum) . consecutiveSubSeq
 48 
 49 maxSum2 :: (Ord a, Num a) => [a] -> a
 50 maxSum2 xs = maximum (concat (map partialSum (tails xs)))
 51 
 52 maxSum3 :: (Ord a, Num a) => [a] -> a
 53 maxSum3 = fst . head . until (null . tail) f . map (\x -> (x, [x])) where
 54     f ((lm, l):(rm, r):xs) = (maximum [maximum (partialSum r) +
 55         maximum (partialSum l), lm, rm], l ++ r) : f xs
 56     f xs = xs
 57 
 58 maxSum4 :: (Ord a, Num a) => [a] -> a
 59 maxSum4 = snd . foldl f (0,0) where
 60     -- here: sum to this point
 61     -- sofar: max so far
 62     f (here,sofar) x = let s=here+x in if (s>0) then (s, max s sofar) else (0, sofar)