DAG DFS with labeled edges

dfs.res

// Implementing DFS by keeping track of colors and times that nodes are
// visited. This allows the algorithm to identify edges as forward edges,
// cross edges, or back edges.
// https://www.personal.kent.edu/~rmuhamma/Algorithms/MyAlgorithms/GraphAlgor/depthSearch.htm

let adj_list = Js.Dict.fromArray([
  ("A", ["C", "D", "B", "H"]),
  ("B", ["E"]),
  ("D", ["E"]),
  ("C", ["E", "G"]),
  ("E", ["F"]),
  ("G", ["F"]),
  ("H", ["F"]),
  ("F", [])
])

type color = White | Gray | Black

// alist must be a DAG
let dfs = (alist) => {
  let time = ref(0)
  // d = time(white -> gray)
  let d = Js.Dict.empty()
  // f = time(gray -> black)
  let f = Js.Dict.empty()

  // All nodes are initially white
  let visited = alist->Js.Dict.keys->Js.Array2.reduce((acc, cur) => {
      acc->Js.Dict.set(cur, White)
      acc
    }, Js.Dict.empty())

  let rec visit = node => {
    visited->Js.Dict.set(node, Gray)
    time := time.contents + 1
    d->Js.Dict.set(node, time.contents)

    switch alist->Js.Dict.get(node) {
    | Some(edges) =>
      edges->Js.Array2.forEach(edge => {
        switch visited->Js.Dict.get(edge) {
        | Some(Black) => {
          if d->Js.Dict.get(node) < d->Js.Dict.get(edge) {
            Js.log(node ++ "->" ++ edge ++ " is forward edge")
          } else {
            Js.log(node ++ "->" ++ edge ++ " is cross edge")
          }
        }
        | Some(Gray) => Js.log(node ++ "->" ++ edge ++ " is back edge")
        | Some(White) => visit(edge)
        }
      })

      visited->Js.Dict.set(node, Black)
      time := time.contents + 1
      f->Js.Dict.set(node, time.contents)
    | None => ()
    }
  }

  alist->Js.Dict.keys->Js.Array2.forEach(node => {
    switch visited->Js.Dict.get(node) {
    | Some(White) => visit(node)
    | _ => ()
    }
  })

  (visited, d, f)
}

let (visited, d, f) = dfs(adj_list)

output.txt

G->F is cross edge
D->E is cross edge
B->E is cross edge
H->F is cross edge