# in output of dpryr's ast function, identify input objects, such as data frames,
#that might contain other objects the user intended to include in the input.
#Then find object-list for each such item (if it exists), and add it to the basic
#object list from searc()
process_ast <- function (ast_output) {
# pattern for a valid R variable name:
variable_pattern <- "`(\\.|[[:alpha:]])([[:alnum:]]|\\.|_)*"
possible_containers <- character()
has_variable_form <- function(string) (length(grep(string,pattern=variable_pattern))>0)
isolate_variable_name <- function(string) {
m <- regexpr(variable_pattern,string)
temp <- regmatches(x=string,m)
return(gsub(temp,pattern="`", replacement=""))
}
#make the list of possible containers:
for (string in ast_output) {
if (has_variable_form(string)) {
possible_cont <- isolate_variable_name(string)
possible_containers <- c(possible_containers,possible_cont)
}
}
#make the basic objects list:
objs <- lapply(search(), objects)
objs <- unique(c(ls(), do.call(c, objs)))
#add on the objects contained in the valid containers:
add_on <- function(x) {
tryCatch(suppressWarnings(objects(eval(parse(text=x)))),
error=function(e){
return(NULL)
})
}
new_objs <- lapply(possible_containers,add_on)
objs <- unique(c(do.call(c,new_objs),objs))
return(objs)
}
##############
## Try combing through the entire call stack for names
######################
get_names <- function(call) {
call <- as.list(call)
give_name <- function(x) {
if (is.name(x)) return(as.character(x)) else return("")
}
results <- sapply(call,give_name)
results[results != ""]
}
cull_calls <- function(call_stack) {
n <- length(call_stack) - 1
if (n == 0)
n <- 1L # In basic case, attempts to iterate over index 1:0
name_roster <- character()
for (i in 1:n) {
name_roster <- c(name_roster, get_names(call_stack[[i]]))
}
name_roster
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.