在警告消息中显示父函数的名称

最简单的方法是使用合适的调用对象显式构造一个条件对象，并将其传递给 。这将覆盖使用调用函数的默认逻辑。warningwarning

mywarn <- function (call = sys.call(sys.parent())) {
  warning(simpleWarning("I warn you", call))
}

myfun(10)

Warning message:
In myfun(10) : I warn you

或：

warnme <- function() {
  call <- deparse(sys.calls()[[sys.nframe()-1]])
  warnmessage <- sprintf("Warning in %s", call)
  warning(warnmessage, call. = FALSE)
}

f <- function(x) {
  warnme()
}

f(2)

在评论中，您指出，针对您的问题的其他解决方案在以下情况下都失败了

sapply(10, myfun) 

他们显示类似的东西

Warning message:
In FUN(X[[i]], ...) : I warn you

我认为如果没有调试信息，这几乎是不可避免的。在调用中，是一个对象; 不在乎它的名字。因此，要将“myfun”放入消息中而不是实现中的局部变量，您需要识别它是从 调用的，并进一步查找调用堆栈以查找被调用的函数的名称。除此之外，还有很多其他功能需要处理，所以这不是一个可行的方法。sapply()myfunsapplysapplymywarnsapplysapply

如果你碰巧知道这将是一个问题，你可以通过做更多的工作来解决它。它可以将自己的名称作为消息的一部分传递，而不是简单地使用错误消息进行调用。这可能很简单myfunmywarn

mywarn("myfun")

或更精细的喜欢

mywarn(call = substitute(myfun(x),list(x = substitute(x))))

（其中一些丑陋可能会被移入，但的存在是必不可少的）。mywarnmyfun(x)

如果在源中启用了调试信息，则可以执行更多操作。如果您使用 ， 但对于包源代码来说，它是可选的。source()

例如，如果将以下代码放在名为 的文件中，然后调用 ，则将获得如下所示的输出：test.Rsource("test.R")

myfun <- function(x) {
  x <- x^2
  mywarn()
  x
}

mywarn <- function (msg = "I warn you", call = sys.call(sys.parent()))
{   
  calls <- sys.calls()
  for (i in rev(seq_along(calls))) {
    location <- getSrcref(calls[[i]])
    if (!is.null(location)) {
      call <- NULL
      filename <- getSrcFilename(location)
      linenum  <- getSrcLocation(location)
      functionname <- findLineNum(attr(location, "srcfile"), linenum)
      if (length(functionname) < 1) prefix <- "At "
      else prefix <- paste0("In ", functionname[[1]]$name, "() at ")
      msg <- sprintf("%s%s#%d: %s", prefix, basename(filename), linenum, msg)
    }
  }
  warning(simpleWarning(msg, call))
}

sapply(10, myfun)

Warning message:
At test.R#25: In myfun() at test.R#3: I warn you  

这表示源文件第 25 行调用了最终到达源文件第 3 行并发出警告的内容。您可以根据自己的喜好使前缀或多或少地提供信息;例如，我可能只包括最近的位置 （）。myfun()In myfun() at test.R#3:

如果在调试信息不存在的情况下工作，它将回退到 @KonradRudolph 的解决方案。

更新

仍然不是 100% 满足 OP 的要求，但也许这会有所帮助。显示触发警告的函数调用的警告，并添加回溯以向下跟踪函数，直到调用警告函数。

mywarn <- function () {
  msg <- sys.calls()
  warning(
    sprintf("In %s : I warn you\n", gsub("[[:space:]]", "", msg[1][1], perl = TRUE)),
    "Traceback : \n", 
    sapply(msg[2:length(msg)], \(x) sprintf("\t%s\n", deparse(x)))
  , call. = F)
}

mywrap <- function(x) myfun(x); mywrap(2)

# Warning message:
#   In mywrap(2) : I warn you
# Traceback : 
#   myfun(x)
#   mywarn()

原始答案

不是 100% 完美，但这是我最接近处理所有 3 种情况的方法

mywarn <- function () {
  msg <- deparse(sys.calls()[[1]])[[1]]
  warning(sprintf("In %s : I warn you", msg), call. = FALSE)
}


myfun <- function(x) {
  x <- x^2
  mywarn()
  x
}

myfun(10)

# Warning message:
# In myfun(10) : I warn you 

sapply(10, myfun)

# Warning message:
# In sapply(10, myfun) : I warn you 

sapply(10, \(x) { mywarn(); x ^2 })

# Warning message:
# In sapply(10, function(x) { : I warn you