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

Answer 3

Might I suggest using a dynamic programming approach? This way of solving 0-1 knapsack problems are almost painfully slow, at least when the amount of variables gets larger than around 20. While it's simple, it's just too ineffective. Here's my shot at it:

import Array

-- creates the dynamic programming table as an array
dynProgTable (var,cap) = a where
    a = array ((0,0),(length var,cap)) [ ((i,j), best i j)
                       | i <- [0..length var] , j <- [0..cap] ] where
        best 0 _ = 0
        best _ 0 = 0
        best i j
            | snd (var !! (i-1)) > j = a!decline
            | otherwise          = maximum [a!decline,value+a!accept]
                where decline = (i-1,j)
                      accept  = (i-1,j - snd (var !! (i-1)))
                      value   = fst (var !! (i-1))

--Backtracks the solution from the dynamic programming table
--Output on the form [Int] where i'th element equals 1 if
--i'th variable was accepted, 0 otherwise.
solve (var,cap) =
    let j = cap
        i = length var
        table = dynProgTable (var,cap)
        step _ 0 _ = []
        step a k 0 = step table (k-1) 0 ++ [0]
        step a k l
            | a!(k,l) == a!(k-1,l) = step a (k-1) l ++ [0]
            | otherwise            = step a (k-1) (l - snd (var !! (k-1))) ++ [1]
    in step table i j

In the input (var,cap), var is a list of variables in the form of 2-tuples (c,w), where c is the cost and w is the weight. cap is the maximum weight allowance.

I'm sure above code could be cleaned up to make it more readable and obvious, but that's how it turned out for me :) Where the code snippet by Landei above is short, my computer took ages computing instances with only 20 variables. The dynamic programming approach above gave me a solution for 1000 variables faster.

If you don't know about dynamic programming, you should check out this link:Lecture slides on dynamic programming, it helped me a lot.

For an introduction to arrays, check out Array tutorial.