Knapsack.hs

import Data.Function.Memoize (memoize)
import Data.List (maximumBy, group)
import qualified Data.Map as Map
import Data.Map.Lazy (empty, insertWith, size, Map)
import Data.Ord (comparing, compare, Down)
import Data.Monoid
import System.Environment (getArgs)


type Solution = (Map Integer Integer, Integer)

compareSol (r1, w1) (r2, w2) = compare w1 w2 `mappend` comparing (Map.foldl' (+) 0) r2 r1

bestUnbounded :: [Integer] -> Integer -> Integer -> [Solution]
bestUnbounded items from till = [msolve x | x <- [from, from - 1..till]] where
    msolve = memoize solve where
        solve capacity
          | capacity == 0          = (empty, 0)
          | all (> capacity) items = (empty, 0)
          | otherwise              = solve' capacity
              where solve' capacity = maximumBy compareSol $ solutions
                    solutions = filter (\ s -> snd s <= capacity) $ map solution items
                    solution i = let (solution', weight) = msolve $ capacity - i
                                  in (insertWith (+) i 1 solution', weight + i)

main = do
    args <- getArgs
    let (till:from:items) = map read args
    mapM print $ bestUnbounded items from till