Posts Tagged ‘directed’

Programming Praxis – Topological Sort

November 19, 2010

In today’s Programming Praxis exercise, our goal is to write two functions related to directed acyclical graphs (DAGs). The first one is to check whether a given directed graph is acyclical. The second is to perform a topological sort of a DAG, which means to sort it so that no node precedes a node that leads to it. Let’s get started, shall we?

A quick import:

import Data.List

The following function is just a bit of syntactic sugar for an operation I use a few times.

with :: (a -> b) -> [a] -> (b -> b -> Bool) -> b -> [a]
with t xs eq x = filter ((eq x) . t) xs

Both functions need to find vertices with no incoming edges.

noIncoming :: Eq a => [(a, a)] -> [a] -> Maybe a
noIncoming es = find (null . with snd es (==))

Checking if a graph is cyclical is a simple matter of recursively removing nodes with no incoming edges to see if any remain, which would mean that the graph is cyclical.

isCyclic :: Eq a => [(a, a)] -> Bool
isCyclic = not . null . until (\x -> remove x == x) remove where
    remove es = maybe es (with fst es (/=)) . noIncoming es $ map fst es

The process for topologically sorting a list is roughly similar: Find a vertex with no incoming edges, remove the edges leading from it and repeat, returning the vertices in the correct order.

tsort :: Eq a => [(a, a)] -> [a]
tsort xs = if isCyclic xs then error "cannot sort cyclic list"
           else f xs . nub . uncurry (++) $ unzip xs where
    f es vs = maybe [] (\v -> v : f (with fst es (/=) v) (delete v vs)) $
              noIncoming es vs

Some tests to see if everything is working correctly:

main :: IO ()
main = do print $ isCyclic [(3,8),(3,10),(5,11),(7,8)
          print $ isCyclic [(3,8),(3,10),(5,11),(7,8),(7,11)
          print $ tsort [(3,8),(3,10),(5,11),(7,8)

We get a different order than the Scheme solution, but as the exercise mentions there are many different possible sorts. Since we’re using a different algorithm, we get different results.