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

Question

以下程序在 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]

Answer 1

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

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

我们甚至可以走得更远：

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

但是，一旦我们要求八元素，我们就卡住了：

GHCi> take 8 $ walk [0]
[0,2,3,4,5,6,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,2,3,4,5,6,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

Answer 2

这里有一个解决方法的想法：嗯，我们需要一个终止条件，对吧？所以让我们保留足够的结构来知道我们应该何时终止。具体来说，我们将生成边界流，而不是生成节点流，并在当前边界为空时停止。

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]

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