如何使用Haskell列出通过图形的所有路径

Question

我是Haskeller的开始。 这是一个我认为需要几分钟才能构建的脚本，但这给我带来了相当大的困难。

假设我们有一个由节点和边组成的图。 数据结构是节点到节点对的列表，如下所示：

[(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]

我想构建一个遍历图形的函数，并显示从起始节点到底部所有可到达节点的所有可能路径。

因此，函数的几个理想执行可能如下所示：

> allPaths 1 [(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]
[[1,6,9],[1,6,10],[1,6,13],[1,8,13]]
> allPaths 8 [(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]
[[8,13]]

这是我刚开始构建路径列表的初始尝试：

allPaths start graph = [start : [snd edge] | edge <- graph, fst edge == start]

> allPaths 8 [(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]
[[1,6],[1,8]]

问题是我不知道如何使这个解决方案使用递归来完成路径。 这是几个没有通过类型检查的蹩脚尝试之一：

allPaths start graph = [start : (snd edge : allPaths (snd edge) graph) | edge <- graph, fst edge == start]

    Occurs check: cannot construct the infinite type: a ~ [a]
    Expected type: [a]
      Actual type: [[a]]
    Relevant bindings include
      edge :: (a, a) (bound at allpaths.hs:5:72)
      graph :: [(a, a)] (bound at allpaths.hs:5:16)
      start :: a (bound at allpaths.hs:5:10)
      allPaths :: a -> [(a, a)] -> [[a]]
        (bound at allpaths.hs:5:1)
    In the second argument of `(:)', namely `allPaths (snd edge) graph'
    In the second argument of `(:)', namely
      `(snd edge : allPaths (snd edge) graph)'
Failed, modules loaded: none.

这是什么意思？ 我的列表嵌套是否太深了。

有没有人有解决方案或更好的方法？

Answer 1

如果切换到图形的不同表示，这将变得更加容易。 我在这里使用的结构不一定是最好或最有效的，我没有对循环关系进行任何检查，但是它比边缘列表更简单。

首先，一些进口

import qualified Data.Map as M

我们的结构是Int节点标签与其子节点之间的关系，所以

type Node = Int
type Children = [Node]
type Graph = M.Map Node Children

现在我们可以写下我们的测试图：

testGraph :: Graph
testGraph = M.fromList
    [ (1,  [6, 8])
    , (6,  [9, 10, 13])
    , (8,  [13])
    , (9,  [])
    , (10, [])
    , (13, [])
    ]

为了使这更简单，您可以编写一个函数，从边缘列表到此结构非常容易：

fromEdges :: [(Node, Node)] -> Graph
fromEdges = M.fromListWith (++) . map (fmap (:[]))

（这不会以相同的顺序添加它们，您可以使用Data.Set.Set缓解此问题。）

现在你只需拥有

testGraph = fromEdges [(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]

为了实现函数allPaths :: Node -> Graph -> [[Node]]事情现在非常简单。 我们只有三个案例需要考虑：

1. 在图中查找节点时，该节点不存在。 应该返回空列表。
2. 节点存在于图中，但没有子节点。 应该返回路径[[node]] 。
3. 该节点存在于图中并具有子节点。 应该返回当前节点前面的所有子节点的所有路径。

所以

allPaths startingNode graph =
    case M.lookup startingNode graph of
        Nothing -> []                -- Case 1
        Just [] -> [[startingNode]]  -- Case 2
        Just kids ->                 -- Case 3
            map (startingNode:) $    -- All paths prepended with current node
                concatMap (`allPaths` graph) kids  -- All kids paths

Answer 2

这是我的尝试：

allPaths :: Int -> [(Int,Int)] -> [[Int]]
allPaths start graph = nextLists
    where
      curNodes = filter (\(f,_) -> f == start) graph
      nextStarts = map snd curNodes
      nextLists = if curNodes == []
                  then [[start]]
                  else map ((:) start) $ concat $ map (\nextStart -> allPaths nextStart graph) nextStarts

在实践中：

*Main> allPaths 1 [(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]
[[1,6,9],[1,6,10],[1,6,13],[1,8,13]]
*Main> allPaths 8 [(1,6),(1,8),(6,9),(6,10),(6,13),(8,13)]
[[8,13]]

Answer 3

在对allPaths的递归调用中会出现此问题。

未能构造无限类型的较短示例是： fx = [fx] 。

这里， f的返回类型必须是f返回的列表。 allPaths 。

通常只需调用concat即可解决此问题。 在您的情况下，由于您使用列表推导而不是列表组合器，这对应于从递归调用中解压缩结果：

allPaths :: Int -> [(Int, Int)] -> [[Int]]
allPaths startNode graph = map (startNode:) (go startNode)
  where
    go curNode =
      case [ snd node | node <- graph, fst node == curNode ] of
        [] -> [[]]
        nextNodes -> [ nextNode : path | nextNode <- nextNodes, path <- go nextNode ]

这里， path <- go nextNode涵盖了你缺少的concatMap 。

Answer 4

WolfeFan在上面给出了一个很好的方法来查找图中的所有路径。 但是当图中有一个循环时，它会进入无限循环。 我只是修改他的代码，以便它可以提供循环路径，如果有的话。

allPaths :: Int -> [(Int,Int)]->[Int] -> [[Int]]
allPaths start graph visited = nextLists
    where
         curNodes = filter (\(f,_) -> f == start) graph
         nextStarts = map snd curNodes
         nextLists |any (\x-> x `elem` visited) nextStarts = [[start]] -- Responsible for prinitng cyclic paths
                   |otherwise = if curNodes == []
                         then [[start]] -- Responsible for printing non-cyclic paths
                                else map ((:) start) $ concat $ map (\nextStart -> allPaths nextStart graph (start:visited)) nextStarts

在实践中：* Main> allPaths 1 [（1,6），（1,8），（6,9），（6,10），（6,13），（8,13），（9,8） ，（8,1）] []

[[1,6,9,8]，[1,6,10]，[1,6,13]，[1,8]二氮杂]