Instantly share code, notes, and snippets.

Embed
What would you like to do?
Visualize internal package functions
library(tidyverse)
library(DiagrammeR)
#Get package functions ----
ls_fcns <- function(pkg) {
fcns <- unclass(lsf.str(envir = asNamespace(pkg), all = TRUE))
return(as.character(fcns))
}
#Search for other package functions called by function
fcn_deps <- function(pkg) {
fcns <- ls_fcns(pkg)
out <- data.frame(Function = as.character(),
Dependency_Function = as.character(),
Number_Calls = as.integer(),
stringsAsFactors = FALSE)
for (i in fcns) {
this_fcn <- capture.output(getAnywhere(i))
for (j in fcns[-grep(i, fcns, fixed = TRUE)]) {
dep_fcns <- grep(paste(j, "(", sep=""), this_fcn, fixed = TRUE)
if (length(dep_fcns > 0)) {
out <- rbind(out,
data.frame(Function = i,
Dependency_Function = j,
Number_Calls = length(dep_fcns),
stringsAsFactors = FALSE))
}
}
}
return(out)
}
plotFcnDependencies <- function(pkg) {
fcns <- ls_fcns(pkg)
depFcn <- fcn_deps(pkg)
depth <- NULL
nodes <- create_node_df(n = length(fcns),
label = fcns,
type = "",
fontsize = 20,
shape = "rectangle")
nodes$id <- 1:nrow(nodes)
edges <- data.frame(fromLab = depFcn$Function,
toLab = depFcn$Dependency_Function,
stringsAsFactors = FALSE)
edges <- nodes %>%
select(from = id, fromLab = label) %>%
right_join(edges, by="fromLab")
edges <- nodes %>%
select(to = id, toLab = label) %>%
right_join(edges, by="toLab") %>%
mutate(rel = "") %>%
select(from, to, rel, fromLab, toLab)
out <- DiagrammeR::create_graph(
nodes_df = nodes,
edges_df = edges,
graph_name = paste(pkg, " (version ", packageVersion(pkg), ") Function Map", sep="")
)
out$global_attrs$value[out$global_attrs$attr == "layout"] <- "dot"
out$global_attrs$value[out$global_attrs$attr == "fixedsize"] <- "false"
out$global_attrs <- rbind(out$global_attrs, data.frame(attr = "rankdir", value = "LR", attr_type = "graph"))
return(out)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment