记录当前函数名称

Question

我有一些自定义日志功能是扩展的cat.一个基本的例子是这样的:

catt<-function(..., file = "", sep = " ", fill = FALSE, labels = NULL,
    append = FALSE)
{
    cat(..., format(Sys.time(), "(%Y-%m-%d %H:%M:%S)"), "\n", file = file, 
        sep = sep, fill = fill, labels = labels, append = append)
}

现在,我使用(自制)函数进行了大量工作,并使用其中一些logfuntions来查看进度,这非常有效.但是,我注意到,我几乎总是使用这样的函数:

somefunc<-function(blabla)
{
  catt("somefunc: start")
  #do some very useful stuff here
  catt("somefunc: some time later")
  #even more useful stuff
  catt("somefunc: the end")
}

注意每个调用如何catt从调用它的函数的名称开始.非常整洁,直到我开始重构我的代码并重命名函数等.

感谢Brian Ripley的一些旧的R-list帖子,如果我没弄错的话,我发现这段代码可以获得'当前的函数名':

catw<-function(..., file = "", sep = " ", fill = FALSE, labels = NULL,
    append = FALSE)
{
    curcall<-sys.call(sys.parent(n=1))
    prefix<-paste(match.call(call=curcall)[[1]], ":", sep="")
    cat(prefix, ..., format(Sys.time(), "(%Y-%m-%d %H:%M:%S)"), "\n",
        file = file, sep = sep, fill = fill, labels = labels, append = append)
}

这非常好,但它并不总是有效,因为:

• 我的函数散布着函数lapply 类型中使用的匿名函数,如下所示:

aFunc<-function(somedataframe)
{
  result<-lapply(seq_along(somedataframe), function(i){
  catw("working on col", i, "/", ncol(somedataframe))
  #do some more stuff here and return something
  return(sum(is.na(somedataframe[[i]])))
  }
}

- >对于这些情况,显然(并且可以理解)我sys.parent在catw函数的调用中需要n = 3 .

• 我偶尔会使用do.call:看来我当前的实现也不起作用(我再次对它有所了解,尽管我还没有完全理解它.

所以,我的问题是:有没有办法在callstack中找到更高的第一个命名函数(跳过日志函数本身,也许还有其他一些"众所周知的"异常),这样我就可catw以为所有情况编写一个单独的版本(这样我可以愉快地重构而不用担心我的日志代码)？你会怎么做这样的事情？

编辑:应支持这些案例:

testa<-function(par1)
{
    catw("Hello from testa, par1=", par1)
    for(i in 1:2) catw("normal loop from testa, item", i)
    rv<-sapply(1:2, function(i){catw("sapply from testa, item", i);return(i)})
    return(rv)
}

testb<-function(par1, par2)
{
    catw("Hello from testb, par1=", par1)
    for(i in 1:2) catw("normal loop from testb, item", i)
    rv<-sapply(1:2, function(i){catw("sapply from testb, item", i);return(i)})

    catw("Will now call testa from testb")
    rv2<-testa(par1)
    catw("Back from testa call in testb")

    catw("Will now do.call testa from testb")
    rv2<-do.call(testa, list(par1))
    catw("Back from testa do.call in testb")

    return(list(rv, rv2))
}

testa(123)
testb(123,456)
do.call(testb, list(123,456))

Answer 1

编辑:完全重写功能

此函数的新版本使用调用堆栈sys.calls(),而不是match.call.

调用堆栈包含完整的调用函数.所以现在的诀窍是只提取你真正想要的那些部分.我已经在clean_cs函数中进行了一些手动清理.此评估在调用栈中的第一个字,并返回所需的参数为少数的公知的边缘的情况下,特别是lapply,sapply和do.call.

这种方法的唯一缺点是它会将函数名一直返回到调用堆栈的顶部.也许合乎逻辑的下一步是将这些函数与一个特定的环境/命名空间进行比较,并根据它来包含/排除函数名称......

我会在这里停下来 它回答了问题中的用例.

新功能:

catw <- function(..., callstack=sys.calls()){
  cs <- callstack
  cs <- clean_cs(cs)
  #browser()
  message(paste(cs, ...))
}

clean_cs <- function(x){
  val <- sapply(x, function(xt){
    z <- strsplit(paste(xt, collapse="\t"), "\t")[[1]]
    switch(z[1],
        "lapply" = z[3], 
        "sapply" = z[3],
        "do.call" = z[2], 
        "function" = "FUN",
        "source" = "###",
        "eval.with.vis" = "###",
        z[1]
        )
    })
  val[grepl("\\<function\\>", val)] <- "FUN"
  val <- val[!grepl("(###|FUN)", val)]
  val <- head(val, -1)
  paste(val, collapse="|")
}

检测结果:

testa Hello from testa, par1= 123
testa normal loop from testa, item 1
testa normal loop from testa, item 2
testa sapply from testa, item 1
testa sapply from testa, item 2


testb Hello from testb, par1= 123
testb normal loop from testb, item 1
testb normal loop from testb, item 2
testb sapply from testb, item 1
testb sapply from testb, item 2
testb Will now call testa from testb
testb|testa Hello from testa, par1= 123
testb|testa normal loop from testa, item 1
testb|testa normal loop from testa, item 2
testb|testa sapply from testa, item 1
testb|testa sapply from testa, item 2
testb Back from testa call in testb
testb Will now do.call testa from testb
testb|testa Hello from testa, par1= 123
testb|testa normal loop from testa, item 1
testb|testa normal loop from testa, item 2
testb|testa sapply from testa, item 1
testb|testa sapply from testa, item 2
testb Back from testa do.call in testb


testb Hello from testb, par1= 123
testb normal loop from testb, item 1
testb normal loop from testb, item 2
testb sapply from testb, item 1
testb sapply from testb, item 2
testb Will now call testa from testb
testb|testa Hello from testa, par1= 123
testb|testa normal loop from testa, item 1
testb|testa normal loop from testa, item 2
testb|testa sapply from testa, item 1
testb|testa sapply from testa, item 2
testb Back from testa call in testb
testb Will now do.call testa from testb
testb|testa Hello from testa, par1= 123
testb|testa normal loop from testa, item 1
testb|testa normal loop from testa, item 2
testb|testa sapply from testa, item 1
testb|testa sapply from testa, item 2
testb Back from testa do.call in testb