我最近花了一些时间尝试在 Haskell 中制作深度优先遍历算法。然而，对于我的，我希望该函数返回一个“已访问”列表，其中按顺序访问了每个节点。
演示：使用图表
[('A', "BC"), ('B', "ACD"), ('C', "AB"), ('D', "B")]"ABCBD"AD这是我的代码：
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 unvisitedNodes) = trav graph (head unvisitedNodes) endNode visited
| not (null visited) = if (length prevIndex) > 1 then (trav graph (visited !! (getIndex (head prevIndex) visited)) endNode (visited ++ [(visited !! (getIndex (head prevIndex) visited))])) else (trav graph (head (tail (reverse visited))) endNode (visited ++ [(head (tail (reverse visited)))]))
| otherwise = visited
where
unvisitedNodes = [x | x <- getAttachedVertexes graph node, not (elem x visited)]
prevIndex = [x | x <- (reverse visited), x < (head (reverse visited))]
getAttachedVertexes :: [(Char, String)] -> Char -> [Char]
getAttachedVertexes graph node = case lookup node graph of
Just value -> value
Nothing -> ""
getIndex :: Eq a => a -> [a] -> Int
getIndex item list = case elemIndex item list of
Just index -> index
Nothing -> error "help"
这段代码实际上工作正常，并输出我在上面输入以下内容时所写的理想输出：
trav [('A', "BC"), ('B', "ACD"), ('C', "AB"), ('D', "B")] 'A' 'D' ""但是，当我输入以下输入时，此代码会启动无限递归循环：
trav [('A', "CDE"), ('B', "D"), ('C', "AD"), ('D', "ABC"), ('E', "A")] 'A' 'E' ""显然没有错误消息，因为它是无限循环。
我的思考过程：
我刚刚用更新的 Haskell 代码编辑了这个问题，这是以下思考的结果：
我首先想到问题的一部分是，当回溯时，回溯到的节点被添加到
visitedhead (tail (reverse visited))我将此代码“翻译”为 Python 3（这是我最有经验的语言），并将其保留为 Haskell 格式，即包含一系列
ifreturn接下来，我尝试修复上述错误。它返回我上面所说的第一个输入的正确输出（
{"A":["B", "C"], "B":["A", "C", "D"], "C":["A", "B"], "D":["B"]}{"A":['C', 'D', 'E'], "B":['D'], "C":['A','D'], "D":['A','B','C'], "E":['A']}这里是Python代码：
def trav(graph, node, endNode, visited):
if node not in visited:
return trav(graph, node, endNode, (visited + [node]))
if node == endNode:
return visited
unvisitedNodes = [x for x in getAttachedNodes(graph, node) if x not in visited]
if len(unvisitedNodes) > 0:
return trav(graph, unvisitedNodes[0], endNode, visited)
if len(visited) > 0:
prevIndex = [x for x in reversed(visited) if x < visited[-1]]
if len(prevIndex) > 1:
return trav(graph, visited[visited.index(prevIndex[0])], endNode, (visited + [visited[visited.index(prevIndex[0])]]))
else:
return trav(graph, visited[-2], endNode, (visited + [visited[-2]]))
return visited
if __name__ == '__main__':
graph1 = {"A":["B", "C"], "B":["A", "C", "D"], "C":["A", "B"], "D":["B"]}
node = input("Node: ")
endNode = input("EndNode: ")
graph2 = {"A":['C', 'D', 'E'], "B":['D'], "C":['A','D'], "D":['A','B','C'], "E":['A']}
visited = []
print(trav(graph2, node, endNode, visited))
我重新编写了 Haskell 代码，现在它在所有测试用例中的运行方式与上述 Python 代码完全相同。显然这只会对那些有Python能力的人有帮助。我写它是为了希望能够理解这个问题。我的下一个编辑将是此 Python 代码的调试结果。
我为它的混乱和低效表示歉意，但我想尽可能地反映上面的 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'