Haskell中动态编程的高效表

Question

我在Haskell中编写了0-1背包问题.到目前为止,我对于懒惰和普遍性水平感到自豪.

我首先提供了创建和处理惰性2d矩阵的函数.

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 105个方法包括项目1-5),则只需要执行最少量的工作.理想情况下,这意味着不会O(i*j)强制将表的每一行的主干强制为必要的列长度.你可以说这不是"真正的"DP,如果你认为DP意味着评估整个表.
• 如果我要求打印整个表(类似于printTable knapsackTable 5 10),每个条目的值应该只计算一次.给定单元格的值应该取决于其他单元格的值(DP样式:想法是,永远不会重新计算相同的子问题两次)

---

思路:

• Data.Array有界:(
• UArray严格:(
• 记忆技术(关于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

基本上,它被实现为具有懒惰脊柱和惰性值的trie.它只受键类型的限制.因为整个事情是懒惰的,所以在用查询强制它之前它的构造是O(1).每个查询都强制沿着trie及其值的单个路径,因此对于有界密钥大小 O(log n),它是O(1).正如我已经说过的那样,它是不可改变的,但不是未装箱的.

它将共享递归调用中的所有工作.它实际上不允许您直接打印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)