ZWA

The unbounded knapsack problem is a packing problem. How can items be packed in a container such that the container is full and the number of items is minimized? A simple application of the unbounded knapsack problem is finding the minimum number of coins that must be returned to a customer as change.

The unbounded qualifier means that there may be any number of items of each size. For example, an unlimited number of pennies might be returned in a (probably suboptimal) solution.

A recursive solution to the problem grows a tree. Working from the change example, starting with the initial change required, we try each coin, subtract the coin from the total change, and recurse into the sub-problem.

ukpNaive :: [Int] -> Int -> Maybe [(Int, Int)]
ukpNaive ds i0 = countRuns . snd <$> (f i0) where
  f :: Int -> Maybe (Int, [Int])
  f i | i < 0 = Nothing
      | i == 0 = Just (0, [])
      | otherwise = minFst $ catMaybes [f (i-j) >>= merge j | j <- ds, j <= i]
      where
        merge j (depth, trace) = Just (depth + 1, j : trace)

        minFst :: Ord a => [(a,b)] -> Maybe (a,b)
        minFst [] = Nothing
        minFst x0@(y0:_) = f y0 x0 where
          f y [] = Just y
          f (a, x) ((b, y):rs)
            | b < a = f (b, y) rs
            | otherwise = f (a, x) rs

-- count the number of times each element in a list appears
countRuns :: (Ord a) => [a] -> [(a, Int)]
countRuns = map (\xs@(x:_) -> (x, length xs)) . DL.group

The inputs to the problem, as shown in the signature on line 1, are a list of weights and the desired weight of the knapsack. For the coin problem, the list of weights are the denominations of the coins. For US currency, then, the weights are 1, 5, 10, 25, and 50 for pennies, nickels, dimes, quarters, and half-dollars. The desired weight is the total change. The return value is a list of pairs expressing each weight and how many times it is used in the solution. For now, we will wrap the return value in Maybe, since the packing may fail if no solution exists.

The recursive function f takes the desired weight and returns the remainder (0 when done) and a list of all coins that have been used. If the change required is less than zero, then we tried a combination that doesn’t work, and return Nothing. If the change required is exactly 0, then we are done, otherwise we try each coin denomination and return the first solution with a minimum number of coins.

This solution works. However, it runs in exponential time and is too slow to be practical even for the trivial coin change problem. The algorithm would exhaustively try every combination of coins.

The algorithm is slow because the same sub-problems are being solved many times across the tree. We can avoid this extra work by storing optimal solutions to the sub-problems in a lookup table. The lookup table needs to be threaded through the program. A natural way to accomplish this in Haskell is through the State monad.

unboundedKnapsack ::
  (Ord cost, Num weight, Ord weight)
  => ((weight, [weight]) -> cost) -- the remainder and the selected weights
  -> [weight] -- weights that are summed to try to hit the goal
  -> weight -- the goal
  -> (weight, [(weight, Int)])
unboundedKnapsack criterion weights goal = reshape $ evalState (ukp goal) Map.empty
  where

  -- given a goal i and single weight j
  chk i j
    -- if the weight overruns the goal, then return no solution (empty list)
    | k < 0 = return (j - i, [])
    -- if the weight equals the goals, then return the weight (we are done)
    | k == 0 = return (0, [j])
    -- else record j and continue, reusing memoized values if available
    | otherwise = do
      (r, xs) <- mem ukp k
      return (r, j:xs)
    where
      k = i - j

  -- select the best score for each choice of weight
  ukp i = fromJust . minimumBy criterion <$> mapM (chk i) weights

  -- organize data into (remainder, counts) tuple
  reshape (r, xs) = (r, countRuns xs)

-- find the minimum value in a list using a given comparator
minimumBy :: Ord b => (a -> b) -> [a] -> Maybe a
minimumBy _ [] = Nothing
minimumBy _ [x] = Just x
minimumBy f (x:xs) = case minimumBy f xs of
  Nothing -> Just x
  (Just y) -> Just $ if f x < f y then x else y

mem :: Ord i => (i -> State (Map i o) o) -> i -> State (Map i o) o
mem f x = do
  m <- get
  case Map.lookup x m of
    (Just x') -> return x'
    Nothing -> do
      x' <- f x
      modify (Map.insert x x')
      return x'

The function is a solution to a more general unbounded knapsack problem. Instead of returning Nothing when no solution exists that exactly sums to the desired weight, we return the best solution and the remainder. For the coin problem, since one of the weights is 1 (the penny), there is a solution for any desired positive integer solution. For example, if the allowed weights were [3,5], and your desired weight was 7, the optimal solution would be to pack 2 3’s and have 1 unit of empty space.

The function also takes a user-provided criterion of optimality. Each recursive step needs to choose among all children which is best. For the coin change problem, the best choice is the one where change exactly hits the goal and has the minimum number of coins. But other problems, like filling a knapsack, might instead want to maximize the number of items in the sack, rather than minimize the remainder. Or the goal could be to minimize remainder but resolve ties with the maximum number of elements. All the cases above, and more, can be implemented by changing the criterion function. Below are a few examples:

-- Minimize remainder first, then minimize number of items. This is the
-- criteria for the exact change problem:
criterion1 (r, xs) = (r, length xs)


-- Minimize remainder first, then maximize number of items.
criterion2 (r, xs) = (r, (-1) * length xs)

-- Or burglar style, throw some big things in a bag and run
criterion2 (r, xs) = (-1) * mean xs + r

To Recurse or Not - Unbounded Knapsack