How to list all paths through graph using Haskell

Question

I'm a beginning Haskeller. This is a script I thought would take a few minutes to build, but it's caused me quite a bit of difficulty.

Say we have a graph composed of nodes and edges. The data structure is a list of node-to-node pairs, like this:

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

I want to build a function that walks through the graph and shows all possible paths from a starting node to all reachable nodes at the bottom.

So a couple ideal executions of the function might look like this:

> 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]]

Here's my initial attempt which just starts to build the list of paths:

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]]

The problem is I don't know how to make this solution use recursion to finish the paths. This is one of several lame attempts which doesn't pass a type check:

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.

What does this mean? Is my list nesting going too deep.

Does anyone have a solution or a better approach?

Answer 1

If you switch to a different representation of a graph this becomes much easier. The structure I'm using here is not necessarily the best or most efficient, and I'm not doing any checking against cyclic relationships, but it is simpler to work with than lists of edges.

First, some imports

import qualified Data.Map as M

The structure we have is a relationship between an Int node label and its child nodes, so

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

Now we can write down our test graph:

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

To make this even simpler, you can write a function to go from your list of edges to this structure pretty easily:

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

(This does not add them in the same order, you could use a Data.Set.Set mitigate this issue.)

Now you simply have

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

For implementing the function allPaths :: Node -> Graph -> [[Node]] things are now pretty straightforward. We have only three cases to consider:

1. When looking up a node in the graph, the node does not exist. Should return the empty list.
2. The node exists in the graph, but has no children. Should return the paths [[node]].
3. The node exists in the graph and has children. Should return all paths of all children prepended with the current node.

So

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

Here's my attempt:

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

In practice:

*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]]