R/prepFunctionName.R

In madrat: May All Data be Reproducible and Transparent (MADRaT) *

#' prepFunctionName
#' 
#' Function to prepare a function call for a given type and prefix
#' 
#' 
#' @aliases prepFunctionName
#' @param type name of calculation/source
#' @param prefix Type of calculations. Available options are "download" (source download), 
#' "read" (source read), "correct" (source corrections), "convert" (source conversion to ISO countries),
#' "calc" (further calculations), and "full" (collections of calculations)
#' @param ignore vector of arguments which should be ignored (not be part of the function call)
#' @param error_on_missing boolean deciding whether a missing type should throw an error or return NULL
#' @return A function call as character to the specified function with corresponding package as attribute
#' @author Jan Philipp Dietrich
#' @seealso \code{\link{readSource}}, \code{\link{setConfig}}
#' @examples
#' 
#' print(madrat:::prepFunctionName("Tau","read"))
#' print(madrat:::prepFunctionName("TauTotal","calc"))
#' print(madrat:::prepFunctionName("EXAMPLE","full"))
#' @importFrom utils tail

prepFunctionName <- function(type, prefix="calc", ignore=NULL, error_on_missing=TRUE) {
  getCalc <- getCalculations(prefix = prefix)
  if(!(type %in% getCalc$type)) {
    if(error_on_missing) {
      stop("Type \"",type, "\" is not a valid output type. Check getCalculations(\"",prefix,"\") for available types!")
    } else {
      return(NULL)
    }
  }
  # creates functionname and checks that all arguments
  # expected by the function are actually beeing provided
  name <- getCalc$call[getCalc$type==type]
  package <- getCalc$package[getCalc$type==type]
  if(length(name)>1) {
    name <- as.character(tail(name,1))
    package <- as.character(tail(package,1))
    warning("More than one function found for type \"",type,"\" and prefix \"",prefix,"\". Use last occurrence (package \"",package,"\")")
    if(package==".GlobalEnv" & type %in% c("TauTotal","Tau")) {
      stop("Cannot substitute package internal function for type \"",type,"\" and prefix \"",prefix,"\" with function in global environment. Please use other function name instead!")  
    } 
  }
  
  # extract arguments which agree between the given function and its corresponding wrapper function
  # (because they have to be mentioned specifically in the function call)
  
  wrapper <- list(calc     = "calcOutput", 
                  download = "downloadSource",
                  read     = "readSource", 
                  correct  = "readSource",
                  convert  = "readSource",
                  full     = "retrieveData")
  
  if(prefix %in% c("convert", "correct")) {
    add <- "x"
  } else{
    add <- NULL
  }
  
  fformals <- names(formals(eval(parse(text = name))))
  wformals <- c(add,names(formals(as.character(wrapper[prefix]))))
  formals <- intersect(wformals, fformals)
  fcomplete <- all(fformals %in% formals)
  formals <- setdiff(formals,"...")
  
  if(!fcomplete & !("..." %in% wformals)) {
    warning("Some arguments of function \"", name, "\" cannot be adressed by the wrapper (\"",
            paste0(fformals[!(fformals %in% formals)], collapse = "\", \""),"\")!")
  }
  
  formals <- setdiff(formals,ignore)
  args <- paste(formals,formals,sep="=")
  if("..." %in% wformals & !fcomplete) args <- c(args,"...")
  out <- paste0(name,'(',paste(args,collapse=", "),')')
  
  attr(out,"formals") <- formals
  attr(out,"package") <- package
  if(package==".GlobalEnv") {
    attr(out,"pkgcomment") <- ".GlobalEnv"
  } else {
    attr(out,"pkgcomment") <- paste(package, unname(getNamespaceVersion(package)))
  }
  return(out)
}