树状数据结构上的Memoization问题

时间:2014-03-24 03:23:50

标签: haskell tree memoization

编辑:虽然我仍然对这个案例中执行所面临的问题的答案感兴趣,但似乎它确实与严格性有关,因为-O修复了执行并且程序可以很快地处理树。

我目前正处理67thProject Euler问题。

我已经使用简单列表和动态编程解决了它。

我现在想用树数据结构解决它(好吧,Node可以有两个父节点,所以它不是真正的树)。我以为我会使用一棵简单的树,但会注意制作它,以便在适当时共享节点:

data Tree a = Leaf a | Node a (Tree a) (Tree a) deriving (Show, Eq)

解决问题只是递归地遍历树:

calculate :: (Ord a, Num a) => Tree a => a
calculate (Node v l r) = v + (max (calculate l) (calculate r))
calculate (Leaf v) = v

显然,这具有指数时间复杂性。所以我试着用以下内容记住结果:

calculate :: (Ord a, Num a) => Tree a => a
calculate = memo go
    where go (Node v l r) = v + (max (calculate l) (calculate r))
          go (Leaf v) = v

其中memo来自Stable Memo。稳定备忘录应根据它是否看到完全相同的参数(如同在内存中一样)来记忆。

所以我使用ghc-vis来查看我的树是否正确地共享节点以避免重新计算已在另一个分支中计算的内容。

在我的函数生成的示例树上:lists2tree [[1], [2, 3], [4, 5, 6]],它返回以下正确的共享:

sample tree http://public.crydee.eu/sample.png

我们可以看到节点5已共享。

然而,在实际的欧拉问题中,我的树似乎没有得到正确的记忆。 代码可用on github,但我想除了上面的计算方法之外,唯一另一个重要的方法是创建树的方法。这是:

lists2tree :: [[a]] -> Tree a
lists2tree = head . l2t

l2t :: [[a]] -> [Tree a]
l2t (xs:ys:zss) = l2n xs ts t
    where (t:ts) = l2t (ys:zss)
l2t (x:[])      = l2l x
l2t []          = undefined

l2n :: [a] -> [Tree a] -> Tree a -> [Tree a]
l2n (x:xs) (y:ys) p = Node x p y:l2n xs ys y
l2n []     []     _ = []
l2n _      _      _ = undefined

l2l :: [a] -> [Tree a]
l2l = map (\l -> Leaf l)

它基本上一次遍历列表两行,然后递归地从下到上创建节点。

这种方法有什么问题?我认为程序仍然可以在到达叶子之前在thunk中产生完整的树解析,因此在记忆之前,避免了memoization的所有好处,但我不确定是不是这样。如果是,有没有办法解决它?

1 个答案:

答案 0 :(得分:1)

这并没有真正解决原始问题,但我发现使用显式记忆通常更简单,更强大。

我选择将三角形存储为由位置而不是树索引的列表:

[     ((1,1),3),
 ((2,1),7), ((2,2), 4), 
 ....

假设部分结果已经在此格式的列表中进行了记忆。然后在特定坐标处计算答案是微不足道的:

a # i = let Just v = lookup i a in v

compute tree result (x,y) = tree # (x,y) + max (result # (x+1,y)) (result # (x+1,y+1))

现在我们必须建立result。这也是微不足道的;我们所要做的就是将compute映射到所有有效索引上。

euler67 :: [((Int, Int), Integer)] -> Integer 
euler67 tree = result # (1,1)
  where 
    xMax = maximum $ map (fst . fst) tree 

    result =    [ ((x,y), compute (x,y)) | x <- [1 .. xMax], y <- [1..x] ] 
             ++ [ ((xMax + 1,y),0) | y <- [1..xMax + 1]]

    compute (x,y) = tree # (x,y) + max (result # (x+1,y)) (result # (x+1,y+1))

计算三角形的高度(xMax)只是获得最大的x-index。当然,我们假设树形成良好。

唯一远程复杂的部分是确定哪些指数对result有效。显然,原始树中的每一行都需要1行。行x将包含x项。我们还在底部添加了一行额外的零 - 我们可以在compute中以特殊方式处理基本情况,但这种方式可能更容易。

你会注意到百行三角形的速度很慢。这是因为lookup每次调用compute时都会遍历三个列表。为了加快速度,我使用了数组:

euler67' :: Array (Int, Int) Integer -> Integer 
euler67' tree = result ! (1,1)
  where 
    ((xMin, yMin), (xMax, yMax)) = bounds tree

    result = accumArray (+) 0 ((xMin, yMin), (xMax + 1, yMax + 1)) $
         [ ((x,y), compute (x,y)) | x <- [xMin .. xMax], y <- [yMin..x] ] 
      ++ [ ((xMax + 1,y),0) | y <- [yMin..xMax + 1]]

    compute (x,y) = tree ! (x,y) + max (result ! (x+1,y)) (result ! (x+1,y+1))

此处还有我用于阅读文件的代码:

readTree' :: String -> IO (Array (Int, Int) Integer)
readTree' path = do
  tree <- readTree path
  let 
    xMax = maximum $ map (fst . fst) tree 
    yMax = maximum $ map (snd . fst) tree 
  return $ array ((1,1), (xMax,yMax)) tree

readTree :: String -> IO [((Int, Int), Integer)]
readTree path = do
  s <- readFile path 
  return $ map f $ concat $ zipWith (\n xs -> zip (repeat n) xs) [1..] $ map (zip [1..] . map read . words) $ lines s
    where 
      f (a, (b, c)) = ((a,b), c)