树状数据结构上的记忆问题

Question

编辑：虽然我仍然对在这种情况下执行所面临的问题的答案感兴趣，但似乎它确实与严格性有关，因为 -O 修复了执行和程序可以非常快速地处理树。

我目前正在处理Project Euler 的67^th 问题。

我已经用简单的列表和动态编程解决了这个问题。

我现在想使用树数据结构来解决它（嗯，一个节点可以有两个父节点，所以它不是真正的树）。我想我会使用一棵简单的树，但会小心地制作它，以便在适当的时候共享节点：

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]]，它返回以下正确共享：

_{（来源：crydee.eu）}

这里我们可以看到节点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 中生成完整的树解析，从而避免记忆的所有好处，但我不确定情况是否如此。如果是，有没有办法解决？

Answer 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)