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:
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) ,(7,11),(11,2),(11,9),(11,10)] print $ isCyclic [(3,8),(3,10),(5,11),(7,8),(7,11) ,(10,5),(11,2),(11,9),(11,10)] print $ tsort [(3,8),(3,10),(5,11),(7,8) ,(7,11),(11,2),(11,9),(11,10)]
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.