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

Question

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

我目前正在研究 67^th Project Euler的问题.

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

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

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

显然，这具有指数时间复杂度。所以我试着用 memoize 结果:

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

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

这种方法有什么问题？我认为该程序可能仍会在到达叶子之前并因此在内存之前以 thunks 的形式生成完整的树解析，从而避免内存的所有好处，但我不确定情况是否如此。如果是，有什么办法可以解决吗？

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)