Topological Sort: Managing Mutable Structures in Haskell

Written By James Bowen

Welcome back to our Rust vs. Haskell comparison series, featuring some of the most common LeetCode questions. We’ve done a couple graph problems the last two weeks, involving DFS and BFS.

Today we’ll do a graph problem involving a slightly more complicated algorithm. We’ll also use a couple data structures we haven’t seen in this series yet, and we’ll see how tricky it can get to have multiple mutable structures in a Haskell algorithm.

To learn all the details of managing your data structures in Haskell, check out Solve.hs, our problem solving course. You’ll learn all the key APIs, important algorithms, and you’ll get a lot of practice with LeetCode style questions!

The Problem

Today’s problem is called Course Schedule. We are given a number of courses, and a list of prerequisites among those courses. For a prerequisite pair (A,B), we cannot take Course A until we have taken Course B. Our job is to determine, in a sense, if the prerequisite list is well-defined. We want to see whether or not the list would actually allow us to take all the courses.

As an example, suppose we had these inputs:

Number Courses: 4
Prerequisites: [(2, 0), (1,0), (3,1), (3,2)]

This is a well defined set of courses. In order to take courses 1 and 2, we must take course 0. Then in order to take course 3, we have to take courses 1 and 2. So if we have the ordering 0->1->2->3, we can take all the courses. So we would return True.

However, if we were to add (1,3) there, we would not be able to take all the courses. We could take courses 0 and 2, but then we would be stuck because 1 and 3 have a mutual dependency. So we would return False with this list.

We are guaranteed that the course indices in the prerequisites list are in the range [0, numCourses - 1]. We are also guaranteed that all prerequisites are unique.

The Algorithm

For our algorithm, we will image these courses as living in a directed graph. If course A is a prerequisite of Course B, there should be a directed edge from A to B. This problem essentially boils down to determining if this graph has a cycle or not.

There are many ways to approach this, including relying on DFS or BFS as we discussed in the past two weeks! However, to introduce a new idea, we’ll solve this problem using the idea of topological sorting.

We can think of nodes as having “in degrees”. The “in degree” of a node is the number of directed edges coming into it. We are particularly concerned with nodes that have an in degree of 0. These are courses with no prerequisites, which we can take immediately.

Each time we “take” a course, we can increment a count of the courses we’ve taken, and then we can “remove” that node from the graph by decrementing the in degrees of all nodes that it is pointing to. If any of these nodes have their in degrees drop to 0 as a result of this, we can then add them to a queue of “0 degree nodes”.

If, once the queue is exhausted, we’ve taken every course, then we have proven that we can satisfy all the requirements! If not, then there must be a cycle preventing some nodes from ever having in-degree 0.

Rust Solution

We’ll start with a Rust solution. We need to manage a few different structures in this problem. The first two will be vectors giving us information about each course. We want to know the current “in degree” as well as having a list of the courses “unlocked” by each course.

Each “prerequisite” pair gives the unlocked course first, and then the prerequisite course. We’ll call these “post” and “pre”, respectively. We increase the in-degree of “post” and add “post” to the list of courses unlocked by “pre”:

pub fn can_finish(num_courses: i32, prerequisites: Vec<Vec<i32>>) -> bool {
    // More convenient to use usize
    let n = num_courses as usize;

    let mut inDegrees = Vec::with_capacity(n);
    inDegrees.resize(n, 0);

    // Maps from “pre” course to “post” course
    let mut unlocks: Vec<Vec<usize>> = Vec::with_capacity(n);
    unlocks.resize(n, Vec::new());

    for req in prerequisites {
        let post = req[0] as usize;
        let pre = req[1] as usize;
        inDegrees[post] += 1;
        unlocks[pre].push(post);
    }
    ...
}

Now we need to make a queue of 0-degree nodes. This uses VecDeque from last time. We’ll go through the initial in-degrees list and add all the nodes that are already 0. Then we’ll set up our loop to pop the front element until empty:

pub fn can_finish(num_courses: i32, prerequisites: Vec<Vec<i32>>) -> bool {
    let n = num_courses as usize;

    ...

    // Make a queue of 0 degree
    let mut queue: VecDeque<usize> = VecDeque::new();
    for i in 0..(num_courses as usize) {
        if inDegrees[i] == 0 {
            queue.push_back(i);
        }
    }

    let mut numSatisfied = 0;
    while let Some(course) = queue.pop_front() {
        ...
    }
    return numSatisfied == num_courses;
}

All we have to do now is process the course at the top of the queue each time now. We always increment the number of courses satisfied, since de-queuing a course indicates we are taking it. Then we loop through unlocks and decrement each of their in degrees. If reducing an in-degree takes it to 0, then we add this unlocked course to the back of the queue:

pub fn can_finish(num_courses: i32, prerequisites: Vec<Vec<i32>>) -> bool {
    let n = num_courses as usize;

    ...

    let mut numSatisfied = 0;
    while let Some(course) = queue.pop_front() {
        numSatisfied += 1;
        for post in &unlocks[course] {
            inDegrees[*post] -= 1;
            if (inDegrees[*post] == 0) {
                queue.push_back(*post);
            }
        }
    }
    return numSatisfied == num_courses;
}

This completes our solution! Here is the full Rust implementation:

pub fn can_finish(num_courses: i32, prerequisites: Vec<Vec<i32>>) -> bool {
    let n = num_courses as usize;
    // Make a vector with inDegree Count
    let mut inDegrees = Vec::with_capacity(n);
    inDegrees.resize(n, 0);

    // Make a vector of "unlocks"
    let mut unlocks: Vec<Vec<usize>> = Vec::with_capacity(n);
    unlocks.resize(n, Vec::new());

    for req in prerequisites {
        let post = req[0] as usize;
        let pre = req[1] as usize;
        inDegrees[post] += 1;
        unlocks[pre].push(post);
    }

    // Make a queue of 0 degree
    let mut queue: VecDeque<usize> = VecDeque::new();
    for i in 0..(num_courses as usize) {
        if inDegrees[i] == 0 {
            queue.push_back(i);
        }
    }

    let mut numSatisfied = 0;
    while let Some(course) = queue.pop_front() {
        numSatisfied += 1;
        for post in &unlocks[course] {
            inDegrees[*post] -= 1;
            if (inDegrees[*post] == 0) {
                queue.push_back(*post);
            }
        }
    }
    return numSatisfied == num_courses;
}

Haskell Solution

In Haskell, we can follow this same approach. However, this is a somewhat challenging algorithm for Haskell beginners, because there are a lot of data structure “modifications” occurring, and expressions in Haskell are immutable! So we’ll organize our solution into three different parts:

  1. Initializing our structures
  2. Writing loop modifiers
  3. Writing the loop

This solution will introduce 2 data structures we haven’t used in this series so far. The IntMap and the Sequence (Seq), which we’ll use qualified like so:

import qualified Data.IntMap.Lazy as IM
import qualified Data.Sequence as Seq

The IntMap type works more or less exactly like a normal Map, with the same API. However, it assumes we have Int as our key type, which makes certain operations more efficient than a generic ordered map.

Then Seq is the best thing to use for a FIFO queue. We would have used this last week if we implemented BFS from scratch.

We’ll also make a few type alias, since we’ll be combining these structures and frequently using them in type signatures:

type DegCount = IM.IntMap Int
type CourseMaps = (DegCount, IM.IntMap [Int])
type CourseState = (Int, Seq.Seq Int, DegCount)

The setup to our problem is fairly simple. Our function takes the number of courses as an integer, and the prerequisites as a list of tuples. We’ll write a number of helper functions beneath this top level definition, but for additional clarity, we’ll show them independently as we write them.

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs = ...

Initializing Our Structures

Recall that the first part of our Rust solution focused on populating 3 structures:

  1. The list of in-degrees (per node)
  2. The list of “unlocks” (per node)
  3. The initial queue of 0-degree nodes

We use IntMaps for the first two (and use the alias DegCount for the first). These are easier to modify than vectors in Haskell. The other noteworthy fact is that we want to create these together (this is why we have the CourseMaps alias combining them). We process each prerequisite pair, updating both of these maps. This means we want to write a folding function like so:

processPrereq :: (Int, Int) -> CourseMaps -> CourseMaps

For this function, we want to define two more helpers. One that will make it easier to increment the key of a degree value, and one that will make it easy to append a new unlock for the other mapping.

incKey :: Int -> DegCount -> DegCount

appendUnlock :: Int -> Int -> IM.IntMap [Int] -> IM.IntMap [Int]

These two helpers are straightforward to implement. In each case, we check for the key existing. If it doesn’t exist, we insert the default value (either 1 or a singleton list). If it exists, we either increment the value for the degree, or we append the new unlocked course to the existing list.

incKey :: Int -> DegCount -> DegCount
incKey k mp = case IM.lookup k mp of
  Nothing -> IM.insert k 1 mp
  Just x -> IM.insert k (x + 1) mp

appendUnlock :: Int -> Int -> IM.IntMap [Int] -> IM.IntMap [Int]
appendUnlock pre post mp = case IM.lookup pre mp of
  Nothing -> IM.insert pre [post] mp
  Just prev -> IM.insert pre (post : prev) mp

Now it’s very tidy to implement our folding function, and apply it to get these initial values:

processPrereq :: (Int, Int) -> CourseMaps -> CourseMaps
processPrereq (post, pre) (inDegrees', unlocks') =
  (incKey post inDegrees', appendUnlock pre post unlocks')

Here’s where our function currently is then:

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs =
  where
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs

Now we want to build our initial queue as well. For this, we just want to loop through the possible course numbers, and add any that are not in the map for inDegrees (we never insert something with a value of 0).

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs =
  where
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs
    queue = Seq.fromList
      (filter (`IM.notMember` inDegrees) [0..numCourses-1])

Writing Loop Modifiers

Now we have to consider what structures are going to be part of our “loop” and how we’re going to modify them. The type alias CourseState already expresses our loop state. We want to track the number of courses satisfied so far, the queue of 0-degree nodes, and the remaining in-degree values.

The key modification is that we can reduce the in-degrees of remaining courses. When we do this, we want to know immediately if we reduced the in-degree to 0. So let’s write a function that decrements the value, except that it deletes the key entirely if it drops to 0. We’ll return a boolean indicating if the key no longer exists in the map after this process:

decKey :: Int -> DegCount -> (DegCount, Bool)
decKey key mp = case IM.lookup key mp of
  Nothing -> (mp, True)
  Just x -> if x <= 1
    then (IM.delete key mp, True)
    else (IM.insert key (x - 1) mp, False)

Now what’s the core function of the loop? When we “take” a course, we loop through its unlocks, reduce all their degrees, and track which ones are now 0. Since this is a loop that updates state (the remaining inDegrees), we want to write a folding function for it:

decDegree :: Int -> (DegCount, [Int]) -> (DegCount, [Int])

First we perform the decrement. Then if decKey returns True, we’ll add the course to our new0s list.

decDegree :: Int -> (DegCount, [Int]) -> (DegCount, [Int])
decDegree post (inDegrees', new0s) =
  let (inDegrees'', removed) = decKey post inDegrees'
  in  (inDegrees'', if removed then (post : new0s) else new0s)

Writing the Loop

With all these helpers at our disposal, we can finally write our core loop. Recall the 3 parts of our loop state: the number of courses taken so far, the queue of 0-degree courses, and the in-degree values. This loop should just return the number of courses completed:

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs = ...
  where
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs
    queue = Seq.fromList
      (filter (`IM.notMember` inDegrees) [0..numCourses-1])

    loop :: CourseState -> Int
    loop (numSatisfied, queue’, inDegrees’) = ...

If the queue is empty, we just return our accumulated number. While we’re at it, the final action is to simply compare this loop result to total number of courses to get our final result:

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs = loop (0, queue, inDegrees) == numCourses
  where
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs
    queue = Seq.fromList
      (filter (`IM.notMember` inDegrees) [0..numCourses-1])

    loop :: CourseState -> Int
    loop (numSatisfied, queue’, inDegrees’) = case Seq.viewl queue' of
      Seq.EmptyL -> numSatisfied
      (course Seq.:< rest) -> ...

We we “pop” the first course off of the queue, we first get the list of “post” courses that could now be unlocked by this course. Then we can apply our decDegree helper to get the final inDegrees’’ map and the “new 0’s”.

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs = loop (0, queue, inDegrees) == numCourses
  where
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs
    queue = Seq.fromList
      (filter (`IM.notMember` inDegrees) [0..numCourses-1])

    loop :: CourseState -> Int
    loop (numSatisfied, queue’, inDegrees’) = case Seq.viewl queue' of
      Seq.EmptyL -> numSatisfied
      (course Seq.:< rest) ->
        let posts = fromMaybe [] (IM.lookup course unlocks)
            (inDegrees'', new0s) = foldr decDegree (inDegrees', []) posts
        ...

Finally, we append the new 0’s to the end of the queue, and we make our recursive call, completing the loop and the function!

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs = loop (0, queue, inDegrees) == numCourses
  where
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs
    queue = Seq.fromList
      (filter (`IM.notMember` inDegrees) [0..numCourses-1])

    loop :: CourseState -> Int
    loop (numSatisfied, queue’, inDegrees’) = case Seq.viewl queue' of
      Seq.EmptyL -> numSatisfied
      (course Seq.:< rest) ->
        let posts = fromMaybe [] (IM.lookup course unlocks)
            (inDegrees'', new0s) = foldr decDegree (inDegrees', []) posts
            queue'' = foldl (Seq.|>) rest new0s
        in  loop (numSatisfied + 1, queue'', inDegrees'')

Here’s the full solution, from start to finish:

type DegCount = IM.IntMap Int
type CourseMaps = (DegCount, IM.IntMap [Int])
type CourseState = (Int, Seq.Seq Int, DegCount)

canFinishCourses :: Int -> [(Int, Int)] -> Bool
canFinishCourses numCourses prereqs = loop (0, queue, inDegrees) == numCourses
  where
    incKey :: Int -> DegCount -> DegCount
    incKey k mp = case IM.lookup k mp of
      Nothing -> IM.insert k 1 mp
      Just x -> IM.insert k (x + 1) mp

    appendUnlock :: Int -> Int -> IM.IntMap [Int] -> IM.IntMap [Int]
    appendUnlock pre post mp = case IM.lookup pre mp of
      Nothing -> IM.insert pre [post] mp
      Just prev -> IM.insert pre (post : prev) mp

    processPrereq :: (Int, Int) -> CourseMaps -> CourseMaps
    processPrereq (post, pre) (inDegrees', unlocks') =
      (incKey post inDegrees', appendUnlock pre post unlocks')
    
    (inDegrees, unlocks) = foldr processPrereq (IM.empty, IM.empty) prereqs

    queue = Seq.fromList
      (filter (`IM.notMember` inDegrees) [0..numCourses-1])

    decKey :: Int -> DegCount -> (DegCount, Bool)
    decKey key mp = case IM.lookup key mp of
      Nothing -> (mp, True)
      Just x -> if x <= 1
        then (IM.delete key mp, True)
        else (IM.insert key (x - 1) mp, False)
    
    decDegree :: Int -> (DegCount, [Int]) -> (DegCount, [Int])
    decDegree post (inDegrees', new0s) =
      let (inDegrees'', removed) = decKey post inDegrees'
      in  (inDegrees'', if removed then (post : new0s) else new0s)
    
    loop :: CourseState -> Int
    loop (numSatisfied, queue', inDegrees') = case Seq.viewl queue' of
      Seq.EmptyL -> numSatisfied
      (course Seq.:< rest) ->
        let posts = fromMaybe [] (IM.lookup course unlocks)
            (inDegrees'', new0s) = foldr decDegree (inDegrees', []) posts
            queue'' = foldl (Seq.|>) rest new0s
        in  loop (numSatisfied + 1, queue'', inDegrees'')

Conclusion

This problem showed the challenge of working with multiple mutable types in Haskell loops. You have to be very diligent about tracking what pieces are mutable, and you often need to write a lot of helper functions to keep your code clean. In our course, Solve.hs, you’ll learn about writing compound data structures to help you solve problems more cleanly. A Graph is one example, and you’ll also learn about occurrence maps, which we could have used in this problem.

That’s all for graphs right now. In the next couple weeks, we’ll cover the Trie, a compound data structure that can help with some very specific problems.

James Bowen
Next

Graph Algorithms in Board Games!