找出在给定函数中调用哪些函数

Question

可能重复:
在R中生成调用图

我想系统地分析给定的函数,以找出在该函数中调用的其他函数.如果可能的话,递归地.

我在milktrader的博客文章中遇到了这个函数,我可以用它来做类似的包(或命名空间)

listFunctions <- function(
    name,
    ...
){ 
    name.0  <- name
    name    <- paste("package", ":", name, sep="")
    if (!name %in% search()) {
        stop(paste("Invalid namespace: '", name.0, "'"))
    }
    # KEEP AS REFERENCE       
#    out <- ls(name)
    funlist <- lsf.str(name)
    out     <- head(funlist, n=length(funlist))
    return(out)
}

> listFunctions("stats")
  [1] "acf"                  "acf2AR"               "add.scope"           
  [4] "add1"                 "addmargins"           "aggregate"           
  [7] "aggregate.data.frame" "aggregate.default"    "aggregate.ts"        
 [10] "AIC"                  "alias"                "anova"               
....
[499] "xtabs"   

然而,我想要一个函数,name它将是函数的名称,返回值是在其中调用的函数的字符向量(或者列表,如果以递归方式完成)name.

动机

我实际上需要某种基于字符的输出(矢量或列表).这样做的原因是,我工作的一个通用的包装功能并行的abitrary"内部函数",你不必经过耗时的试错的过程,以找出其他功能内在的功能取决于.所以我之后的函数的输出将直接用于snowfall::sfExport()和/或snowfall::sfSouce.

编辑2012-08-08

由于两面派有一些近距离投票,我将在明天检查答案如何与其他问题合并.

Answer 1

试试这个例子:

library(codetools)

ff <- function(f) {
  leaf <- function (e, w) {
    r <- try(eval(e), silent = TRUE)
    if(!is.null(r) && is.function(r)) ret <<- c(ret, as.character(e))
  }
  call <- function (e, w) {
    walkCode(e[[1]], w)
    for (a in as.list(e[-1])) if (!missing(a)) walkCode(a, w)
  }
  ret <- c()
  walkCode(body(f), makeCodeWalker(call = call, leaf = leaf, write = cat))
  unique(ret)
}

然后,

> ff(data.frame)
 [1] "{"               "<-"              "if"              "&&"              "is.null"         "row.names"       "function"        "is.character"   
 [9] "new"             "as.character"    "anyDuplicated"   "return"          "||"              "all"             "=="              "stop"           
[17] "gettextf"        "warning"         "paste"           "which"           "duplicated"      "["               "as.list"         "substitute"     
[25] "list"            "-"               "missing"         "length"          "<"               "!"               "is.object"       "is.integer"     
[33] "any"             "is.na"           "unique"          "integer"         "structure"       "character"       "names"           "!="             
[41] "nzchar"          "for"             "seq_len"         "[["              "is.list"         "as.data.frame"   ".row_names_info" ">"              
[49] "deparse"         "substr"          "nchar"           "attr"            "abs"             "max"             "("               "%%"             
[57] "unclass"         "seq_along"       "is.vector"       "is.factor"       "rep"             "class"           "inherits"        "break"          
[65] "next"            "unlist"          "make.names"      "match"           ".set_row_names" 
> ff(read.table)
 [1] "{"              "if"             "&&"             "missing"        "file"           "!"              "text"           "<-"             "textConnection"
[10] "on.exit"        "close"          "is.character"   "nzchar"         "inherits"       "stop"           "isOpen"         "open"           ">"             
[19] "readLines"      "<"              "min"            "("              "+"              "lines"          ".Internal"      "quote"          "length"        
[28] "all"            "=="             "pushBack"       "c"              "stdin"          "scan"           "col"            "numeric"        "-"             
[37] "for"            "seq_along"      "["              "max"            "!="             "warning"        "paste0"         ":"              "make.names"    
[46] "names"          "is.null"        "rep"            "match"          "any"            "<="             "rep.int"        "list"           "%in%"          
[55] "sapply"         "do.call"        "data"           "flush"          "[["             "which"          "is.logical"     "is.numeric"     "|"             
[64] "gettextf"       "&"              "is.na"          "type.convert"   "character"      "as.factor"      "as.Date"        "as.POSIXct"     "::"            
[73] "methods"        "as"             "row.names"      ".set_row_names" "as.integer"     "||"             "is.object"      "is.integer"     "as.character"  
[82] "anyDuplicated"  "class"          "attr"          

Answer 2

必须有更好的方法,但这是我的尝试:

listFunctions <- function(function.name, recursive = FALSE, 
                          checked.functions = NULL){

    # Get the function's code:
    function.code <- deparse(get(function.name))

    # break code up into sections preceding left brackets:
    left.brackets <- c(unlist(strsplit(function.code, 
                                       split="[[:space:]]*\\(")))

    called.functions <- unique(c(unlist(sapply(left.brackets, 
                                               function (x) {

        # Split up according to anything that can't be in a function name.
        # split = not alphanumeric, not '_', and not '.'
        words <- c(unlist(strsplit(x, split="[^[:alnum:]_.]")))

        last.word <- tail(words, 1)
        last.word.is.function <- tryCatch(is.function(get(last.word)),
                                      error=function(e) return(FALSE))
        return(last.word[last.word.is.function])
    }))))

    if (recursive){

        # checked.functions: We need to keep track of which functions 
        # we've checked to avoid infinite loops.
        functs.to.check <- called.functions[!(called.functions %in%
                                          checked.functions)]

        called.functions <- unique(c(called.functions,
            do.call(c, lapply(functs.to.check, function(x) {
                listFunctions(x, recursive = T,
                              checked.functions = c(checked.functions,          
                                                    called.functions))
                }))))
    }
    return(called.functions)
}

结果如下:

> listFunctions("listFunctions", recursive = FALSE)
 [1] "function"      "deparse"       "get"           "c"            
 [5] "unlist"        "strsplit"      "unique"        "sapply"       
 [9] "tail"          "tryCatch"      "is.function"   "return"       
[13] "if"            "do.call"       "lapply"        "listFunctions"

> system.time(all.functions <- listFunctions("listFunctions", recursive = TRUE))
   user  system elapsed 
  92.31    0.08   93.49 

> length(all.functions)
  [1] 518

如您所见,递归版本返回了许多函数.这个问题是它返回进程中调用的每个函数,这显然会随着你的进行而增加.无论如何,我希望你可以使用它(或修改它)来满足你的需求.