5

下面的程序导致<<loop>>GHC。

...明显地。事后看来。

发生这种情况是因为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]
4

2 回答 2

4

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

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]

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

于 2021-02-21T18:21:03.937 回答
2

查看您的代码表明我们应该能够至少检索 的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,2,3,4,5,6,1

（有趣的是，与编译程序不同，在 GHCi 中尝试它似乎不会触发<<loop>> 检测器。）

只有当超出唯一模 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 的另类打结策略，为了完整起见，我觉得值得提出一个不打结的解决方案。下面的实现是一个展开，它产生了步行的连续关卡（本着李耀夏建议的精神）。这样就可以在访问完所有元素后停止：

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
于 2021-02-21T21:31:09.107 回答