Haskell通用DFS实现能否检测邻接表环？如何扩展保留功能并支持检测？

原函数代码与核心逻辑 #

先贴出原Haskell代码：

-- | Depth-first search.
--
-- Generates the list of unique visited states from a
-- given starting state. States are unique up to the
-- characterizing function.
dfsOnN ::
  Ord r =>
  (a -> r)   {- ^ state characterization              -} ->
  (a -> [a]) {- ^ successors function                 -} ->
  [a]        {- ^ initial states                      -} ->
  [a]        {- ^ visited states in depth-first order -}
dfsOnN rep next = loop S.empty
  where
    loop _ [] = []
    loop !seen (x:xs)
      | S.member r seen =     loop seen xs
      | otherwise       = x : loop seen1 (next x ++ xs)
      where
        r     = rep x
        seen1 = S.insert r seen

这个函数的核心是用一个seen集合记录所有访问过的状态，遇到已访问的状态直接跳过，最终生成去重后的DFS访问序列。

能否直接用于环检测？ #

不能。环检测需要区分两种"已访问"状态：

• 已完成状态：已经处理完所有后继的节点
• 活跃状态：当前DFS递归路径上正在处理的节点

原函数把所有已访问节点都放进同一个seen集合，当遇到已存在的节点时，无法判断它是当前路径上的节点（代表存在环），还是之前分支处理过的节点（属于正常重复访问）。比如调用dfsOnN id neighbors vertices时，遇到已访问节点就直接跳过，完全无法识别环的存在。

扩展方案：保留原功能同时支持环检测 #

我们可以扩展函数返回值，同时输出访问序列、环的存在性以及检测到的环。核心是维护两个集合：seen记录已完成节点，active记录当前路径的活跃节点。

修改后的函数如下：

import qualified Data.Set as S

-- | 带环检测的深度优先搜索
-- 返回值：(DFS访问序列, 是否存在环, 检测到的环列表)
dfsOnNWithCycle ::
  Ord r =>
  (a -> r)   {- ^ 状态特征函数 -} ->
  (a -> [a]) {- ^ 后继函数 -} ->
  [a]        {- ^ 初始状态 -} ->
  ([a], Bool, [[a]])
dfsOnNWithCycle rep next = loop S.empty S.empty [] []
  where
    -- loop 参数：已完成集合、活跃集合、当前路径、已找到的环、待处理队列
    loop seen active path cycles [] = (reverse path, not (null cycles), cycles)
    loop seen active path cycles (x:xs)
      -- 情况1：当前状态在活跃集合中，说明找到环
      | S.member r active = 
          let cycle = x : takeWhile (/= x) (reverse path) ++ [x]
              newCycles = cycle : cycles
          in loop seen active path newCycles xs
      -- 情况2：当前状态已处理完成，直接跳过
      | S.member r seen = loop seen active path cycles xs
      -- 情况3：新状态，加入活跃集合继续DFS
      | otherwise = 
          let newActive = S.insert r active
              newPath = x : path
              -- 先处理后继，再处理原有队列（保持DFS顺序）
              (finalPath, hasCycle, finalCycles) = loop seen newActive newPath cycles (next x ++ xs)
              -- 处理完后继后，将状态移到已完成集合
              newSeen = S.insert r seen
          in loop newSeen S.empty finalPath finalCycles xs
      where
        r = rep x

示例使用 #

针对邻接表场景，调用示例如下：

-- 示例邻接表：1->2, 2->3, 3->1（存在环）
neighbors :: Int -> [Int]
neighbors 1 = [2]
neighbors 2 = [3]
neighbors 3 = [1]
neighbors _ = []

vertices :: [Int]
vertices = [1,2,3]

-- 调用扩展后的函数
main = do
  let (visited, hasCycle, cycles) = dfsOnNWithCycle id neighbors vertices
  putStrLn $ "访问序列: " ++ show visited
  putStrLn $ "是否存在环: " ++ show hasCycle
  putStrLn $ "检测到的环: " ++ show cycles

运行输出：

访问序列: [1,2,3]
是否存在环: True
检测到的环: [[1,2,3,1]]

这个扩展版本既保留了原函数生成DFS访问序列的功能，又能准确识别环——当遇到活跃集合中的节点时，可从当前路径中提取出完整的环结构。

内容的提问来源于stack exchange，提问作者Brendan Langfield