R/VarsRequired.R

Defines functions fn.vars.required

Documented in fn.vars.required

fn.vars.required <- function(my.functions, ...){
####################
    ## READ VARIABLES REQUIRED
####################
  
    extract.formals <- function(x) {
        vv <- names(formals(x))
        vv <- vv[!vv %in% c('tr', 'fl', '...')]
        return(vv)
    }
    is.arg.function <- function(x)  {
        x[sapply(x, function(x) if (exists(x)) is.function(get(x)) else FALSE)]
        }
    vars.required <- numeric(0)

    ## ellipsis
    fn <- list(...) 
    fn <- unlist(unname(fn))
    vars.required <- unique(c(vars.required, fn))
    
    fn <- fn[unlist(lapply(fn, function(x) !is.null(x)))] ## remove nulls
    fn <- is.arg.function(fn)
    
    for(my.fn2 in fn){
        if (is.function (get(my.fn2))){
            fn2 <- extract.formals(get(my.fn2[[1]]))
            vars.required <- unique(c(vars.required, fn2))
            }
    }

    
    ## Main functions
    for (my.fn in unlist(unname(my.functions))){
        ##print(my.fn)
        fn <- extract.formals(get(my.fn))
        fn <- fn[unlist(lapply(fn, function(x) !is.null(x)))] ## remove nulls
        fn <- is.arg.function(fn)
        vars.required <- unique(c(vars.required, fn))
        
        if (length(fn) != 0){
            for ( my.fn2 in fn){
                my.fn2 <- extract.formals(get(my.fn2))
                my.fn2 <- my.fn2[unlist(lapply(my.fn2, function(x) !is.null(x)))] 
                my.fn2 <- is.arg.function(my.fn2)
                vars.required <- unique(c(vars.required, my.fn2))
                }
            }
    }
    return(vars.required)

}

## reassignInPackage("fn.vars.required", "sitree", fn.vars.required)

Try the sitree package in your browser

Any scripts or data that you put into this service are public.

sitree documentation built on July 5, 2017, 9:02 a.m.