Topological sort in Haskell

Question

I have a data type Graph which looks like this:

data Graph w = Graph {vertices :: [(Char, w)],
                      edges :: [(Char, Char, w)]} deriving Show

This is representing a directed acyclic graph. Where vertices have a char identifier ('a' for the first vertice added, 'b' for the second and so on) and a weight. Edges are two vertice identifiers and a weight.

I'm thinking about making the vertices a bit more complex, maybe they should contain a list of all neighbours?

The topological ordering looks like this so far:

topological_ordering :: Graph w -> [Char]
topological_ordering (Graph v w) =
    let startingNodes = getStartNodes (Graph v w)
        emptyList = []
        sorted = sortAlgorithm startingNodes emptyList (Graph v w)
    in sorted

sortAlgorithm :: [Char] -> [Char] -> Graph w -> [Char]
sortAlgorithm startingNodes sorted (Graph v w) =
    | [] _ _ = []
    | (x:startingNodes) sorted (Graph v w) =
      let sorted = sorted ++ [x]
          neigbours = findNeighbours (Graph v w) x

getStartNodes :: Graph w -> [Char]
getStartNodes (Graph v w) =
    let set1 = Set.fromList $ firstNodes w
        set2 = Set.fromList $ secondNodes w
        startNodes = Set.toList $ Set.difference set1 set2
    in  startNodes

firstNodes :: [(Char, Char, w)] -> [Char]
firstNodes [] = []
firstNodes (x:xs) = selectFirst x:firstNodes xs

secondNodes :: [(Char, Char, w)] -> [Char]
secondNodes [] = []
secondNodes (x:xs) = selectSecond x:secondNodes xs

From there I'm a little lost. I don't really know how to complete the sortAlgorithm, because I want it to be recursive (or use foldl/foldr?). Should implement the data type for Graph in another way or should I continue with this?

I just started haskell a few weeks ago and still feel a bit lost on functional programming.

Thanks

Answer 1

You might want to take a look at how elegantly it is done in Data.Graph. Here is an outline of the algorithm:

topSort      :: Graph -> [Vertex]
topSort       = reverse . postOrd

postOrd      :: Graph -> [Vertex]
postOrd       = postorderF . dff

postorder :: Tree a -> [a]
postorder (Node a ts) = postorderF ts ++ [a]

postorderF   :: Forest a -> [a]
postorderF ts = concat (map postorder ts)

-- | A spanning forest of the graph, obtained from a depth-first search of
-- the graph starting from each vertex in an unspecified order.
dff          :: Graph -> Forest Vertex
dff g         = dfs g (vertices g)

-- | A spanning forest of the part of the graph reachable from the listed
-- vertices, obtained from a depth-first search of the graph starting at
-- each of the listed vertices in order.
dfs          :: Graph -> [Vertex] -> Forest Vertex

That is, a topological sort of a graph is (the reverse of) a post-order traversal of a spanning forest of the graph.

Here is an example of how to use it:

  import qualified Data.Graph as G

  {-
     5 --> 7
     |     |
     v     V
     1 --> 4 --> 8
  -}

  (myGraph,vertexToNode,keyToVertex) = G.graphFromEdges [
      ("node4",4,[8]),     -- the first component can be of any type
      ("node8",8,[]),
      ("node7",7,[4]),
      ("node5",5,[1,7]),
      ("node1",1,[4])
   ]

  sorted = map vertexToNode $ G.topSort myGraph
  -- [("node5",5,[1,7]),("node7",7,[4]),("node1",1,[4]),("node4",4,[8]),("node8",8,[])]

Answer 2

Do you have a solid algorithmic approach how to tackle topological sort? There are different possibilities; the two best-known are probably the following:

• Do a DFS on the graph and sort the vertices according to their finish time in descending order. So: If you already have DFS, adapt it do output finish times and sort vertices in descending order.

• The other approach requires you to store the number of incoming, not-yet-processed edges into each vertex (this possibly requires some preprocessing, usually one graph traversal - let's call the corresponding field for each vertex the "edge counter"). Starting nodes - of course - have edge counter = 0. As the next vertex, you can only pick those whose edge counter is set to 0. If you encounter an edge (a,b,w), you have to decrement the edge counter of b by 1.

  Note that this second approach can be implemented in a way such you have a list candidates that is initially only filled with the starting nodes. As soon as you decrement the edge counter of b and see that it is now 0, you add b to the candidates. In the next step, you pick the head of candidates as the next vertex to process.

  To store the edge count, you could use e.g. a HashMap.

Here some (non-haskell, but probably-close-to-haskell) inspiration for the second approach:

sortAlgorithm startingNodes sorted (Graph v w) edgeCounts =
    | [] _ _ = sorted    -- processed all nodes? => output result
    | (x:remainingNodes) sorted (Graph v w) =
      let newEdgeCounts = foldl 
          (\ec (a, b, w) -> Data.HashMap.insert ((Data.HashMap.findWithDefault 0 b ec) - 1) ec)
      in sortAlgorithm remainingNodes (sorted ++ [x]) newEdgeCounts