Haskell 中动态规划的高效表

Question

我已经用Haskell编写了0-1背包问题。我对迄今为止所取得的懒惰和普遍性水平感到相当自豪。

我首先提供用于创建和处理惰性二维矩阵的函数。

mkList f = map f [0..]
mkTable f = mkList (\i -> mkList (\j -> f i j))

tableIndex table i j = table !! i !! j

然后，我为给定的背包问题制作一个特定的表格

knapsackTable = mkTable f
    where f 0 _ = 0
          f _ 0 = 0
          f i j | ws!!i > j = leaveI
                | otherwise = max takeI leaveI
              where takeI  = tableIndex knapsackTable (i-1) (j-(ws!!i)) + vs!!i
                    leaveI = tableIndex knapsackTable (i-1) j

-- weight value pairs; item i has weight ws!!i and value vs!!i
ws  = [0,1,2, 5, 6, 7] -- weights
vs  = [0,1,7,11,21,31] -- values

，并使用几个辅助函数来查看该表格，

viewTable table maxI maxJ = take (maxI+1) . map (take (maxJ+1)) $ table
printTable table maxI maxJ = mapM_ print $ viewTable table maxI maxJ

这非常简单。但我想更进一步。

我想要一个更好的表数据结构。理想情况下，它应该是

• 未装箱（不可变） [编辑]别介意这个
• 惰性
• 无界
• O(1) 构造
• 查找给定条目的O(1)时间复杂度，
  （更现实地说，最坏的情况是 O(log n)，其中 n 是 i*j，用于查找第 i 行、j 列的条目）

如果您能解释一下，即可加分您的解决方案为何/如何满足这些理想。

如果您可以进一步概括 knapsackTable，并证明它是有效的，也会加分。

在改进数据结构时，您应该尝试满足以下目标：

• 如果我要求最大权重为 10 的解决方案（在我当前的代码中，这将是 indexTable knapsackTable 5 10，5 意味着包括第 1-5 项），仅应执行最少量的必要工作。理想情况下，这意味着不需要 O(i*j) 来强制表格每行的主干达到必要的列长度。如果您认为 DP 意味着评估整个表，那么您可以说这不是“真正的”DP。
• 如果我要求打印整个表格（例如 printTable knapsackTable 5 10），则每个条目的值应该计算一次且仅一次。给定单元格的值应取决于其他单元格的值（DP 风格：想法是，永远不要重新计算同一子问题两次）

---

想法：

• Data.Array 有界 :(
• UArray strict :(
• 记忆技术（关于Haskell中的DP的问题）这可能有效

对我所说的做出一些妥协的答案只要它们提供了丰富的信息，就会被投票赞成。妥协最少的答案可能是“被接受”的答案。

Answer 1

首先，您对未装箱数据结构的标准可能有点误导。未装箱的值必须是严格的，并且它们与不变性无关。我要提出的解决方案是不可变的、惰性的和盒装的。另外，我不确定您希望以何种方式构建和查询为 O(1)。我提议的结构是惰性构建的，但由于它可能是无界的，因此其完整构建将需要无限的时间。对于任何大小为 k 的特定键，查询结构将花费 O(k) 时间，但当然您正在查找的值可能需要更多时间来计算。

数据结构是惰性字典树。我在代码中使用 Conal Elliott 的 MemoTrie 库。为了通用性，它使用函数而不是列表来表示权重和值。

knapsack :: (Enum a, Num w, Num v, Num a, Ord w, Ord v, HasTrie a, HasTrie w) =>
            (a -> w) -> (a -> v) -> a -> w -> v
knapsack weight value = knapsackMem
  where knapsackMem = memo2 knapsack'
        knapsack' 0 w = 0
        knapsack' i 0 = 0
        knapsack' i w
          | weight i > w = knapsackMem (pred i) w
          | otherwise = max (knapsackMem (pred i) w)
                        (knapsackMem (pred i) (w - weight i)) + value i

基本上，它是作为一个具有惰性脊柱和惰性值的特里树来实现的。它仅受密钥类型的限制。因为整个事情是惰性的，所以在使用查询强制执行之前的构造是 O(1)。每个查询都会强制沿着 trie 及其值使用一条路径，因此对于有界键大小，其时间复杂度为 O(1) O(log n)。正如我已经说过的，它是不可变的，但不是拆箱的。

它将分担递归调用中的所有工作。它实际上不允许您直接打印 trie，但是这样的事情不应该做任何多余的工作：

mapM_ (print . uncurry (knapsack ws vs)) $ range ((0,0), (i,w))

Answer 2

Unboxed 意味着严格和有界。任何 100% 未装箱的东西都不能是惰性的或无限制的。通常的妥协体现在将 [Word8] 转换为 Data.ByteString.Lazy，其中存在未装箱的块（严格的 ByteString），它们以无限制的方式延迟链接在一起。

可以使用“scanl”、“zipWith”和我的“takeOnto”制作更高效的表生成器（增强以跟踪单个项目）。这有效地避免了在创建表时使用 (!!)：

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) 

Answer 3

惰性可存储向量：http://hackage.haskell.org/package/storablevector

无界，惰性， O(chunksize) 构建时间，O(n/chunksize) 索引，其中 chunksize 对于任何给定目的都可以足够大。基本上是一个具有一些显着的常数因子优点的惰性列表。

Answer 4

为了记忆函数，我推荐像 Luke Palmer 的 memo Combinators 这样的库。该库使用 try，它是无界的并且具有 O(key size) 查找。 （一般来说，你不能比 O(key size) 查找更好，因为你总是必须触及密钥的每一位。）

knapsack :: (Int,Int) -> Solution
knapsack = memo f
    where
    memo    = pair integral integral
    f (i,j) = ... knapsack (i-b,j) ...

在内部，integral 组合器可能会构建一个无限数据结构

data IntTrie a = Branch IntTrie a IntTrie

integral f = \n -> lookup n table
     where
     table = Branch (\n -> f (2*n)) (f 0) (\n -> f (2*n+1))

Lookup 的工作方式如下：

lookup 0 (Branch l a r) = a
lookup n (Branch l a r) = if even n then lookup n2 l else lookup n2 r
     where n2 = n `div` 2

还有其他方法可以构建无限尝试，但这种方法很流行。

Answer 5

为什么不使用 Data.Map 将另一个 Data.Map 放入其中？据我所知，速度相当快。
但也不会偷懒。

不仅如此，您还可以为数据实现 Ord 类型类

data Index = Index Int Int

，并直接将二维索引作为键。您可以通过将此地图生成为列表来实现惰性，然后只需使用

fromList [(Index 0 0, value11), (Index 0 1, value12), ...]