Topo sort dm

topo_sort_dm.R

dfs <- function(x, child, parent) {

  visit <- function(i) {
    if (perm[i]) {
      return(NULL)
    }

    if (temp[i]) stop("Not a DAG")

    temp[i] <<- TRUE

    for (j in unique(parent[which(i == child)])) visit(j)

    temp[i] <<- FALSE
    perm[i] <<- TRUE

    res <<- c(i, res)

    NULL
  }

  stopifnot(
    identical(length(child), length(parent)),
    all(child %in% x), all(parent %in% x), all(child != parent)
  )

  if (!length(child)) {
    return(x)
  }

  child <- match(child, x)
  parent <- match(parent, x)

  perm <- logical(length(x))
  temp <- logical(length(x))

  res <- integer()

  while (!all(perm)) {
    visit(which(!perm)[1L])
  }

  x[res]
}

topo_sort_tables <- function(dm) {
  dm_fks <- dm::dm_get_all_fks(dm)
  dfs(names(dm), dm_fks[["child_table"]], dm_fks[["parent_table"]])
}