MaximumSublist.hs

-- Chapter 4.1 in "Introduction to Algorithms" (3rd edition)
-- Linear algorithm (Exercise 4.1-5)

{-# LANGUAGE BangPatterns #-}

module Main where

import Data.List (inits, tails, maximumBy)
import Data.Function (on)
import Test.QuickCheck

findMaximumSublist :: [Double] -> (Int, Double)
findMaximumSublist [] = error "empty list"
findMaximumSublist as = go 0 (-1, -1/0) (-1, -1/0) as
  where
    go :: (Num a, Ord a) => Int -> (Int, a) -> (Int, a) -> [a] -> (Int, a)
    go _  (!i1, !s1) (!i2, !s2) [] = if s1 > s2 then (i1, s1) else (i2, s2)
    go !i (!i1, !s1) (!i2, !s2) (a:as) =
      let (i1', s1') = if s1 > s2 then (i1, s1) else (i2, s2)
          (i2', s2') = if s2 < 0  then (i, a)   else (i2, s2 + a)
      in go (i+1) (i1', s1') (i2', s2') as

naiveFindMaximumSublist :: [Double] -> (Int, Double)
naiveFindMaximumSublist as = maximumBy (compare `on` snd)
                           $ zip [0..]
                           $ map findMaximumFromBeginning
                           $ filter (not . null)
                           $ tails as
  where findMaximumFromBeginning as = maximum
                                    $ map sum
                                    $ filter (not . null)
                                    $ inits as

prop_compareAlgorithms :: [Double] -> Property
prop_compareAlgorithms as = not (null as) ==>
                            naiveFindMaximumSublist as == findMaximumSublist as

main :: IO ()
main = quickCheck prop_compareAlgorithms