如何在 Haskell 中避免 <<loop>>？

编程问答 2022-05-24

问题描述

下面的程序在 GHC 中产生 <<loop>>。

……显然。事后看来。

发生这种情况是因为 walk 正在计算一个不动点，但有多个可能的不动点。当列表理解到达图遍历的末尾时，它“询问”answer 的下一个元素；但这正是它已经在尝试计算的。我想我认为程序会到达，呃，列表的末尾，然后停止。

我不得不承认，我对这段漂亮的代码有点感伤，希望我能让它发挥作用。

  • 我应该怎么做？

  • 我如何预测“打结”（指的是表示如何计算值的表达式中的值）是一个坏主意？

import Data.Set(Set)
import qualified Data.Set

-- Like `Data.List.nub`,remove duplicate elements from a list,-- but treat some values as already having been seen.
nub :: Set Integer -> [Integer] -> [Integer]
nub _ [] = []
nub seen (x:xs) =
  if Data.Set.member x seen
  then nub seen xs
  else x : nub (Data.Set.insert x seen) xs

-- A directed graph where the vertices are integers.
successors :: Integer -> [Integer]
successors x = [(x + 2) `mod` 7,(x + 3) `mod` 7]

-- Breadth first search of a directed graph.  Returns a list of every integer
-- reachable from a root set in the `successors` graph.
walk :: [Integer] -> [Integer]
walk roots =
  let rootSet = Data.Set.fromList roots
      answer = roots ++ nub rootSet [y | x <- answer,y <- successors x]
  in answer

main = putStrLn $ show $ walk [0]

解决方法

这是如何修复它的一个想法：好吧，我们需要一个终止条件，对吗？所以让我们保持足够的结构来知道我们什么时候应该终止。具体来说，我们不会产生节点流，而是产生边界流，并在当前边界为空时停止。

import Data.Set(Set)
import qualified Data.Set as S

-- Like `Data.List.nub`,but for nested lists. Order in inner lists is not
-- preserved. (A variant that does preserve the order is not too hard to write,-- if that seems important.)
nestedNub :: Set Integer -> [[Integer]] -> [[Integer]]
nestedNub _ [] = []
nestedNub seen (xs_:xss) = S.toList xs : nestedNub (seen `S.union` xs) xss where
  xs = S.fromList xs_ `S.difference` seen

-- A directed graph where the vertices are integers.
successors :: Integer -> [Integer]
successors x = [(x + 2) `mod` 7,(x + 3) `mod` 7]

walk :: [Integer] -> [Integer]
walk roots =
  let answer = nestedNub S.empty
        $ roots
        : [[y | x <- frontier,y <- successors x] | frontier <- answer]
  in concat $ takeWhile (not . null) answer

main = print $ walk [0]

几乎可以肯定没有通用算法可以知道什么时候打结是个坏主意——我的直觉说这是一个停滞不前的问题，尽管我承认我没有尝试解决细节！

,

查看您的代码表明我们至少应该能够检索 root 的 answer 前缀，因为它不依赖于打结。果然：

GHCi> take 1 $ walk [0]
[0]

我们甚至可以走得更远：

GHCi> take 7 $ walk [0]
[0,2,3,4,5,6,1]

然而，一旦我们要求八个元素，我们就会陷入困境：

GHCi> take 8 $ walk [0]
[0,1

（有趣的是，在 GHCi 中尝试它似乎不会绊倒 the <<loop>> detector，这与编译程序不同。）

该问题仅在超出唯一模 7 整数列表的第七个元素时才会出现，这指向问题的核心。从您的定义中删除 nub 为我们提供了一个完美的无限列表：

walkWithDuplicates :: [Integer] -> [Integer]
walkWithDuplicates roots =
  let rootSet = Data.Set.fromList roots
      answer = roots ++ [y | x <- answer,y <- successors x]
  in answer

GHCi> (!! 9999) $ walkWithDuplicates [0]
2

在无限列表上使用 nub 是有风险的。如果其中不同元素的数量是有限的，那么在某一时刻将不会产生下一个元素。

那怎么办？如果我们事先知道图表的大小，就像你的例子一样，我们可以愉快地作弊：

walkKnownSize :: [Integer] -> [Integer]
walkKnownSize roots =
  let graphSize = 7
      rootSet = Data.Set.fromList roots
      answer = roots ++ nub rootSet [y | x <- answer,y <- successors x]
  in take graphSize answer

GHCi> walkKnownSize [0]
[0,1]

（请注意，如果我们将您的图形作为大小、根和 Int -> Integer -> [Integer] 后继函数的三元组传递给函数，则指定图形大小根本不会让人觉得作弊。）

除此之外还有Daniel Wagner's alternative knot-tying strategy，为了完整性，我觉得值得把一个没有打结的解决方案放在桌面上。下面的实现是一个展开，生成步行的连续级别（本着 Li Yao Xia's suggestion 的精神）。这样就可以在访问完所有元素后停止：

import Data.List (unfoldr)
-- etc.

walkUnfold :: [Integer] -> [Integer]
walkUnfold roots =
    let rootsSet = Data.Set.fromList roots
        nextLevel (previouslySeen,currentLevel) =
            let seen = foldr Data.Set.insert previouslySeen currentLevel
                candidates = concatMap successors currentLevel
                newlyVisited = nub seen candidates
            in case newlyVisited of
                [] -> Nothing
                _ -> Just (newlyVisited,(seen,newlyVisited))
        levels = roots : unfoldr nextLevel (Data.Set.empty,roots)
    in concat levels
fixed-point-iterationhaskellhaskelltying-the-knot