Efficient table for Dynamic Programming in Haskell

Question

I\'ve coded up the 0-1 Knapsack problem in Haskell. I\'m fairly proud about the laziness and level of generality achieved so far.

I start by providing functions for crea

Answer 1

Unboxed implies strict and bounded. Anything 100% Unboxed cannot be Lazy or Unbounded. The usual compromise is embodied in converting [Word8] to Data.ByteString.Lazy where there are unboxed chunks (strict ByteString) which are linked lazily together in an unbounded way.

A much more efficient table generator (enhanced to track individual items) could be made using "scanl", "zipWith", and my "takeOnto". This effectively avoid using (!!) while creating the table:

import Data.List(sort,genericTake)

type Table = [ [ Entry ] ]

data Entry = Entry { bestValue :: !Integer, pieces :: [[WV]] }
  deriving (Read,Show)

data WV = WV { weight, value :: !Integer }
  deriving (Read,Show,Eq,Ord)

instance Eq Entry where
  (==) a b = (==) (bestValue a) (bestValue b)

instance Ord Entry where
  compare a b = compare (bestValue a) (bestValue b)

solutions :: Entry -> Int
solutions = length . filter (not . null) . pieces

addItem :: Entry -> WV -> Entry
addItem e wv = Entry { bestValue = bestValue e + value wv, pieces = map (wv:) (pieces e) }

-- Utility function for improve
takeOnto :: ([a] -> [a]) -> Integer -> [a] -> [a]
takeOnto endF = go where
  go n rest | n <=0 = endF rest
            | otherwise = case rest of
                            (x:xs) -> x : go (pred n) xs
                            [] -> error "takeOnto: unexpected []"

improve oldList wv@(WV {weight=wi,value = vi}) = newList where
  newList | vi <=0 = oldList
          | otherwise = takeOnto (zipWith maxAB oldList) wi oldList
  -- Dual traversal of index (w-wi) and index w makes this a zipWith
  maxAB e2 e1 = let e2v = addItem e2 wv
                in case compare e1 e2v of
                     LT -> e2v
                     EQ -> Entry { bestValue = bestValue e1
                                 , pieces = pieces e1 ++ pieces e2v }
                     GT -> e1

-- Note that the returned table is finite
-- The dependence on only the previous row makes this a "scanl" operation
makeTable :: [Int] -> [Int] -> Table
makeTable ws vs =
  let wvs = zipWith WV (map toInteger ws) (map toInteger vs)
      nil = repeat (Entry { bestValue = 0, pieces = [[]] })
      totW = sum (map weight wvs)
  in map (genericTake (succ totW)) $ scanl improve nil wvs

-- Create specific table, note that weights (1+7) equal weight 8
ws, vs :: [Int]
ws  = [2,3, 5, 5, 6, 7] -- weights
vs  = [1,7,8,11,21,31] -- values

t = makeTable ws vs

-- Investigate table

seeTable = mapM_ seeBestValue t
  where seeBestValue row = mapM_ (\v -> putStr (' ':(show (bestValue v)))) row >> putChar '\n'

ways = mapM_ seeWays t
  where seeWays row = mapM_ (\v -> putStr (' ':(show (solutions v)))) row >> putChar '\n'

-- This has two ways of satisfying a bestValue of 8 for 3 items up to total weight 5
interesting = print (t !! 3 !! 5)