Last active
September 8, 2020 14:37
-
-
Save carlbfrederick/b30d861ea80a27fad4e44623c41e0170 to your computer and use it in GitHub Desktop.
Visualize internal package functions
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(tidyverse) | |
library(DiagrammeR) | |
#Get package functions ---- | |
ls_fcns <- function(pkg) { | |
fcns <- unclass(lsf.str(envir = asNamespace(pkg), all = TRUE)) | |
return(as.character(fcns)) | |
} | |
#Utility Function to weed out false positives | |
scan_fcn <- function(from, to) { | |
this_fcn <- trimws(capture.output(getAnywhere(from)), which = "both") | |
#subset to guts of function definition | |
start <- min(grep("^function", this_fcn)) + 1 | |
stop <- max(grep("^}", this_fcn)) - 1 | |
if(is.infinite(start) | is.infinite(stop)){ | |
start <- 0 | |
stop <- 0 | |
} | |
this_fcn <- this_fcn[start:stop] | |
#Remove comment lines | |
this_fcn <- this_fcn[!grepl("^#", this_fcn)] | |
#Lines called functions directly | |
idx1 <- grepl(paste(to, "\\(", sep=""), this_fcn) | |
#Lines called via *map*, *walk*, mutate_at/all, summarize_at/all, *apply | |
idx2 <- grepl(to, this_fcn) & | |
(grepl("summari[sz]e\\_(all)?(if)?(at)?\\(", this_fcn) | | |
grepl("(trans)?mute?(ate)?\\_(all)?(if)?(at)?\\(", this_fcn) | | |
grepl("[lp]?map2?(\\_if)?(\\_at)?(\\_lgl)?(\\_chr)?(\\_int)?(\\_dbl)?(\\_raw)?(\\_dfr)?(\\_dfc)?(\\_depth)?\\(", this_fcn) | | |
grepl("p?walk2?\\(", this_fcn) | | |
grepl("[ltsmvr]?apply\\(", this_fcn)) | |
sum(idx1 | idx2) | |
} | |
#Search for other package functions called by function | |
fcn_deps <- function(pkg) { | |
fcns <- ls_fcns(pkg) | |
out <- tibble( | |
Function = fcns, | |
Dependency_Function = fcns | |
) %>% | |
expand(Function, Dependency_Function) %>% | |
filter(Function != Dependency_Function) %>% | |
mutate( | |
Number_Calls = map2_int(Function, Dependency_Function, scan_fcn) | |
) %>% | |
filter(Number_Calls > 0) | |
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
Thanks for the code ! It's amazing ! I get an error though..., I suggest adding this lines into the scan_fcn function, line 17, just after the computation of start and stop:
With this it works perfectly for me.