Module dependency graph for an R package

deps.R

devtools::load_all()

envir <- as.environment("package:darn")

deps <- mvbutils::foodweb(where = envir, plotting = FALSE)
funmat <- deps$funmat

funs <- mget(colnames(funmat), envir, mode = "function")
fun_files <-
  lapply(funs, attr, "srcref") %>%
  lapply(attr, "srcfile") %>%
  purrr::compact() %>%
  lapply("[[", "filename") %>%
  vapply(basename, character(1L))

missing_funs <- setdiff(colnames(funmat), names(fun_files))
fun_files <- c(fun_files, setNames(paste0("<", missing_funs, ">"), missing_funs))
fun_files <- fun_files[colnames(funmat)]

files <- sort(unique(fun_files))

trans_mat <- matrix(0, nrow = length(files), ncol = length(fun_files), dimnames = list(files, names(fun_files)))
#trans_mat_idx <- matrix(c(match(fun_files, files), seq_along(fun_files)), ncol = 2)
trans_mat_idx <- matrix(c(fun_files, names(fun_files)), ncol = 2)
trans_mat[trans_mat_idx] <- 1

stopifnot(colnames(trans_mat) == names(fun_files))
stopifnot(rownames(trans_mat) == names(files))

stopifnot(colnames(funmat) == rownames(funmat))
stopifnot(colnames(funmat) == names(fun_files))

deps <- trans_mat %*% funmat %*% t(trans_mat) %>%
  as.table %>%
  as.data.frame(stringsAsFactors = FALSE) %>%
  setNames(c("MASTER", "SLAVE", "n")) %>%
  dplyr::filter(n > 0, MASTER != SLAVE) %>%
  dplyr::arrange(MASTER)

graph_from_deps <- function(deps) {
  V <- unique(c(deps$MASTER, deps$SLAVE))
  E <- plyr::dlply(deps, "MASTER", function(x) list(edges = x$SLAVE, weights = x$n))
  EL <- E[V]
  names(EL) <- V
  EL[vapply(EL, is.null, logical(1L))] <- list(list(edges = character(), weights = numeric()))

  graph::graphNEL(V, EL, edgemode = "directed")
}

library(Rgraphviz)
g <- gridGraphviz::agopenTrue(graph_from_deps(deps), "Dependencies",
                              attrs = list(node = list(shape = "ellipse")),
                              recipEdges= "distinct")

gridGraphviz::grid.graph(
  g,
  newpage = TRUE
)