Visualize internal package functions

packageFunctionMap.R

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)
}

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:

if(is.infinite(start) | is.infinite(stop)){
    start <- 0
    stop <- 0
  }

With this it works perfectly for me.

Thanks @emaigne! I will do that.