Haskell 深度优先图遍历具有无限循环

@lrainey6-eng，

首先，正如 @willeM_ Van Onsem 在对您的问题的评论中指出的那样，您的树中有循环。让我们用不同的输入来尝试一下。让我们尝试以下节点列表：[（'A'， “BC”）， （'B'， “DE”）， （'C'， “FG”）， （'D'， “HI”）， （'E'， “JK”）， （'F'， “LM”）， （'G'， “NO”）]。如果我们从“A”开始搜索“O”，我们应该期待“ABDHIEJKCFLMGN”的路径。正确？

           A-0
          / \
         /   \
        /     \
       /       \
      /         \
     B-1         C-8 
    / \         / \
   /   \       /   \
  D-2   E-5   F-9   G-12
 / \   / \   / \   / \
H   I J   K L   M N   O
3   4 6   7 10 11 13 14

我无法遵循您的程序，但我编写了自己的程序进行比较。我想尝试将其放入 Python 中，只是为了体验。无论如何，这是我想出的：

{-# LANGUAGE TemplateHaskell #-}
-- Necessary for running `quickCheckAll` as `runTests` (see EOF)

import Test.QuickCheck
import Test.QuickCheck.All

-- Just for clarity
type Label = Char
type Node = (Label, [Label])
type Path = [Label]

-- Lazily traverse the depthOrder path, until target is found
pathTo :: [Node] -> Label -> Path
pathTo nodes target = takeWhile (not . (==) target)
                      (depthOrder nodes)

-- Find root -- node label that is not a sub of any other nodes
-- Start with root label and `cons` with expansion of root subs
depthOrder :: [Node] -> Path
depthOrder nodes = root : concatMap (expand nodes) subs
  where
    (root, subs) = head [(l, ss) | (l,ss) <- nodes, l `notElem` allSubs]
    allSubs = concat [subs | (label,subs) <- nodes]

-- Every expansion of a sub label, recursively calls for expansion of the
-- subs that follow from that label
expand :: [Node] -> Label -> Path
expand nodes label = label : concatMap (expand nodes)
                                       (getSubs label nodes)

-- For every sub label we search the node list for a node with that label,
-- and if there is one, get the subs for that node.
getSubs :: Char -> [Node] -> [Char]
getSubs label nodes = safeHead (dropWhile (not . (==) label . fst) nodes)
  where safeHead [] = []
        safeHead ((label,subs):ns) = subs 

----------------------------------------------------------------------------

-- simple expansion of one label into a path, based on depth order with
-- left sub searched befor right sub
prop_expand0 :: Property
prop_expand0 = property (expand [('B',"DE")] 'B' == "BDE")

-- if there is no node label in the node list that matches, the label is a
-- "leaf"
prop_expand1 :: Property
prop_expand1 = property (expand [('A',"BC")] 'Z' == "Z")

-- expanding from a predetermined root
prop_expand2 :: Property
prop_expand2 = property
  (expand [('A',"BC"),('B',"DE"),('C',"FG")] 'A' == "ABDECFG")

-- getting depthOrder for a node list, requires first finding a root
prop_depthOrder0 :: Property
prop_depthOrder0 = property
  (depthOrder [('B',"DE"),('C',"FG"),('A',"BC")] == "ABDECFG")

-- once we have a DEFINITION of the depth order of the node list, a simple
-- 'take' of the order will give us the path to the target label
prop_pathTo0 :: Property
prop_pathTo0 = property
  (pathTo [('A',"BC"),('B',"DE"),('C',"FG")] 'G' == "ABDECF")
  
prop_depthOrder1 :: Property
prop_depthOrder1 = property
  (depthOrder [('A', "BC"), ('B', "DE"), ('C', "FG"), ('D', "HI"),
               ('E', "JK"), ('F', "LM"), ('G', "NO")] == "ABDHIEJKCFLMGNO")
-- which is what we predicted at the outset


-- necessary pieces for running `quickCheckAll` on all our test properties
return []
runTests = $quickCheckAll

如果我们运行：？pathTo [('t',"Hr"),('h',"ij"),('q',"sT"),('i'," tE"),('T',"r"), (' ',""),('E',"!q"),('H',"e")] 'q'

我刚刚解决了这个问题。以下是更新后的 Haskell 代码：

import Data.List (elemIndex)

trav :: [(Char, String)] -> Char -> Char -> String -> String
trav [] _ _ _ = []
trav graph node endNode visited
    | not (elem node visited) = trav graph node endNode (visited ++ [node])  -- repeat but after adding this node to visited list.
    | node == endNode = visited
    | not (null unvisitedAttachedNodes) = trav graph (head unvisitedAttachedNodes) endNode visited
    | not (null visited) = if not (null attachedNodesWithUnvisited) then (trav graph (head attachedNodesWithUnvisited) endNode (visited ++ [(head attachedNodesWithUnvisited)])) else (trav graph (head (tail (reverse visited))) endNode (visited ++ [head (tail (reverse visited))]))
    | otherwise = visited
    where
        unvisitedAttachedNodes = [x | x <- getAttachedVertexes graph node, not (elem x visited)]
        prevIndex = [x | x <- (reverse visited), x < (head (reverse visited))]
        unvisitedPrevNodes = [x | x <- prevIndex, elem x [y | y <- (getAttachedVertexes graph x), not (elem y visited)]]
        nodeToGoBackTo = visited !! (getIndex (head (reverse unvisitedPrevNodes)) visited)
        attachedNodesWithUnvisited = [nb | nb <- (getAttachedVertexes graph node), (hasUnvisited graph nb visited)]

getAttachedVertexes :: [(Char, String)] -> Char -> [Char]
getAttachedVertexes graph node = case lookup node graph of
    Just value -> value
    Nothing -> ""

hasUnvisited :: [(Char, String)] -> Char -> String -> Bool
hasUnvisited graph node visited = not (null unvisited) where
    unvisited = [x | x <- (getAttachedVertexes graph node), not (elem x visited)]

count :: Eq a => a -> [a] -> Int
count item list = length (filter (== item) list)

getIndex :: Eq a => a -> [a] -> Int
getIndex item list = case elemIndex item list of
    Just index -> index
    Nothing -> error "help"

下面是更新的等效 Python 代码：

def trav(graph, node, endNode, visited):
    if node not in visited:
        return trav(graph, node, endNode, (visited + [node]))
    if node == endNode:
        return visited
    unvisitedAttachedNodes = [x for x in getAttachedNodes(graph, node) if x not in visited]
    if len(unvisitedAttachedNodes) > 0:
        return trav(graph, unvisitedAttachedNodes[0], endNode, visited)
    if len(visited) > 0:  # needs to backtrack
        attachedNodesWithUnvisited = [nb for nb in graph[node] if has_unvisited(graph, nb, visited)]
        if len(attachedNodesWithUnvisited) > 0:
            return trav(graph, attachedNodesWithUnvisited[0], endNode, visited + [attachedNodesWithUnvisited[0]])
        else:
            return trav(graph, visited[-2], endNode, visited + [visited[-2]])
    return visited

我意识到无限循环是由以下原因引起的，每当需要回溯时，程序只返回一个节点，但随后将该节点添加到访问列表中，因此（或 Python 等效项意味着程序在两个节点之间继续运行。正如您在新的 Python 翻译中清楚地看到的那样，除非有一个附加节点具有未访问的相邻节点，否则我现在将这样做。head (tail (reverse visited))visited[-2]visited[-2]

现在，这适用于我用它测试过的所有图形。

非常感谢大家的帮助！

在我之前的回答（见上文）中，我包括了一个用于对树进行深度优先搜索的程序，其中节点不会自行循环。有人向我指出，这里的问题涉及可以循环回溯的图形。在这里，我将调整以前的程序，使其也适用于一般的图形（包括树）。

将上述树木程序调整为图形通常需要进行多次修改。有点微不足道的是，如果没有明确的根节点，该函数就会返回，就像树一样。相反，一般图形使用一个名为的函数，该函数既需要起点，也需要目标标签。（不包含在下面的代码中，请参阅前面的答案开始）pathToNothingpathFromTo

主要区别在于作为程序核心的功能。以前，只有树，我们可以毫无顾虑地将相同的节点列表传递给每个递归扩展，因为永远不会出现扩展导致自身的另一个扩展和无限循环的情况。对于图形，深度搜索路径要求每个节点在展开时从节点列表中删除，因此无法再次展开或“访问”。expand

附加函数 ， 删除具有给定标签的节点和子节点。此外，我们之前允许节点列表包含未明确列为终端节点（“叶子”）本身的子节点。这会导致不必要的复杂情况，因此我们必须坚持（通过不变性）将子节点作为节点包含在内，如下所示： .remove[('A',"BC"),('B',""),('C',"") … ]

remove nodes label = [(l,[s | s <-ss, s /= label])
                            | (l,ss) <- nodes, l /= label]

由于搜索路径在最左边的分支之前向下扩展，然后再向右边的分支展开，因此子节点的扩展取决于从左侧的节点返回的节点列表。这意味着我们不能再像以前使用'concatMap（扩展节点）（getSubs标签节点）“那样对所有子节点使用简单的映射。现在我们需要使用一个递归函数，将修改后的节点列表传递给每个连续的子扩展。

通过这些更改，仅树的基本程序通常适用于图形。

比较：

-- Every expansion of a sub label, recursively calls for expansion of the
-- subs that follow from that label
expand :: [Node] -> Label -> Path
expand nodes label = label : concatMap (expand nodes)
                                       (getSubs label nodes)

自：

-- Every expansion of a subnode label, recursively calls for expansion of
-- the subnodes that follow from THAT label.
-- To avoid loops and 'visiting' nodes more than once, every expansion will
-- remove the node being expanded from derivative expansions.
-- Since leftmost branches are evaluated first, the node list is resolved
-- before passing to the next branch right, and then the branch right of it.
expand :: [Node] -> [Label] -> Path
expand _ [] = ""
expand nodes (label:ls)
  | getSubs label nodes == Nothing = ""             -- no longer in list
                        ++ expand nodes ls          -- cont to other nodes
  | getSubs label nodes == Just ("") = [label]      -- a leaf
                        ++ expand (nodes `remove` [label]) ls
  | otherwise = label : leftPath ++ recOnRSubs      -- left to right
                        ++ expand                   ---- through subnodes
                           (nodes `remove` (label : leftPath ++ recOnRSubs))
                           ls
  where
    (lSub:rSubs) = fromJust (getSubs label nodes)
    leftPath = expand (nodes `remove` [label]) [lSub]
    recOnRSubs = expand (nodes `remove` (label:leftPath)) rSubs

remove :: [Node] -> [Label] -> [Node]
remove nodes visited = [(l, [s | s <- ss, s `notElem` visited])
                               | (l,ss) <- nodes, l `notElem` visited]

注意：在它说的行中，我已经明确了最左边子节点的扩展，然后再移动到右边子节点上的递归。这不是绝对必要的。人们可以在子节点上使用递归版本来包含最左边的节点，但我喜欢左边路径的显式方式。我认为，它有助于引导读者。otherwise = label : leftPath ++ recOnRSubs …