Haskell Knapsack

Question

I've written an answer to the bounded knapsack problem with one of each item in Scala, and tried transposing it to Haskell with the following result:

knapsack :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> Int -> [ ( Int, Int ) ]
knapsack xs [] _   = xs
knapsack xs ys max =
    foldr (maxOf) [ ] [ knapsack ( y : xs ) ( filter (y /=) ys ) max | y <- ys
        , weightOf( y : xs ) <= max ]

maxOf :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> [ ( Int, Int ) ]
maxOf a b = if valueOf a > valueOf b then a else b

valueOf :: [ ( Int, Int ) ] -> Int
valueOf [ ]        = 0
valueOf ( x : xs ) = fst x + valueOf xs

weightOf :: [ ( Int, Int ) ] -> Int
weightOf [ ]        = 0
weightOf ( x : xs ) = snd x + weightOf xs

I'm not looking for tips on how to clean up the code, just to get it working. To my knowledge it should be doing the following:

• For each tuple option (in ys)
  • if the weight of the current tuple (y) and the running total (xs) combined is less than the capacity
  • get the optimal knapsack that contains the current tuple and the current total (xs), using the available tuples (in ys) less the current tuple
• Finally, get the most valuable of these results and return it

*Edit: * Sorry, forgot to say what's wrong... So it compiles alright, but it gives the wrong answer. For the following inputs, what I expect and what it produces:

knapsack [] [(1,1),(2,2)] 5
Expect: [(1,1),(2,2)]
Produces: [(1,1),(2,2)]

knapsack [] [(1,1),(2,2),(3,3)] 5
Expect: [(2,2),(3,3)]
Produces: []

knapsack [] [(2,1),(3,2),(4,3),(6,4)] 5
Expect: [(2,1),(6,4)]
Produces: []

So I was wondering what could be the cause of the discrepancy?

The solution, thanks to sepp2k:

ks = knapsack []

knapsack :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> Int -> [ ( Int, Int ) ]
knapsack xs [] _   = xs
knapsack xs ys max =
    foldr (maxOf) [ ] ( xs : [ knapsack ( y : xs ) ( ys #- y ) max
                             | y <- ys, weightOf( y : xs ) <= max ] )

(#-) :: [ ( Int, Int ) ] -> ( Int, Int ) -> [ ( Int, Int ) ]
[ ]        #- _ = [ ]
( x : xs ) #- y = if x == y then xs else x : ( xs #- y )

maxOf :: [ ( Int, Int ) ] -> [ ( Int, Int ) ] -> [ ( Int, Int ) ]
maxOf a b = if valueOf a > valueOf b then a else b

valueOf :: [ ( Int, Int ) ] -> Int
valueOf [ ]        = 0
valueOf ( x : xs ) = fst x + valueOf xs

weightOf :: [ ( Int, Int ) ] -> Int
weightOf [ ]        = 0
weightOf ( x : xs ) = snd x + weightOf xs

Which returns the expected results, above.

Answer 1

Your first case fires when ys contains. so for knapsack [foo,bar] [] 42, you get back [foo, bar], which is what you want. However it does not fire when ys contains nothing except elements that would put you over the max weight, i.e. knapsack [(x, 20), (y,20)] [(bla, 5)] will return [] and thus discard the previous result. Since this is not what you want you should adjust your cases so that the second case only fires if there's at least one element in ys that's below the max weight.

One way to do that would be to throw out any elements that put you over the max weight when recursing, so that that scenario simply can't happen.

Another way would be to switch the order of the cases and add a guard to the first case that says that ys must contain at least one element that does not put you over the total weight (and adjust the other case to not require ys to be empty).

PS: Another, unrelated problem with your code is that it ignores duplicates. I.e. if you use it on the list [(2,2), (2,2)] it will act as if the list was just [(2,2)] because filter (y /=) ys will throw out all occurrences of y, not just one.

Answer 2

Some improvements on your working version:

import Data.List
import Data.Function(on)

ks = knapsack []

knapsack :: [(Int, Int)] -> [(Int, Int)] -> Int -> [(Int, Int)]
knapsack xs [] _   = xs
knapsack xs ys max =
    foldr (maxOf) [] (xs: [knapsack (y:xs) (delete y ys) max
                           | y <- ys, weightOf(y:xs) <= max ] ) where
                             weightOf = sum . map snd

maxOf :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
maxOf a b = maximumBy (compare `on` valueOf) [a,b] where
            valueOf = sum . map fst