如何访问分配给函数内函数结果的变量名称?

How do I access the name of the variable assigned to the result of a function within the function?

例如,假设我希望能够定义一个函数,该函数返回与第一个参数连接的赋值变量的名称:

a <- add_str("b")
a
# "ab"

上面示例中的函数看起来像这样:

add_str <- function(x) {
  arg0 <- as.list(match.call())[[1]]
  return(paste0(arg0, x))
}

但是函数的 arg0 行被一行替换,该行将获取被赋值的变量的名称 ("a") 而不是函数的名称。

我试过 match.call 和 sys.call,但我无法让它工作。这里的想法是对变量和函数结果调用赋值运算符,因此应该是函数调用的父调用。

我认为该函数无法访问分配给它的变量。它在函数范围之外,您不会将任何指针传递给它或以任何方式指定它。如果你要将它指定为参数,你可以这样做:

add_str <- function(x, y) {
  arg0 <-deparse(substitute(x))
  return(paste0(arg0, y))
}

a <- 5
add_str(a, 'b')
#"ab"

这通常是不可能的,因为运算符 <- 实际上被解析为对 <- 函数的调用:

rapply(as.list(quote(a <- add_str("b"))), 
       function(x) if (!is.symbol(x)) as.list(x) else x,
       how = "list")
#[[1]]
#`<-`
#
#[[2]]
#a
#
#[[3]]
#[[3]][[1]]
#add_str
#
#[[3]][[2]]
#[1] "b"

现在,您可以通过将负数传递给sys.call来访问调用堆栈上的早期调用,例如

 foo <- function() {
  inner <- sys.call()
  outer <- sys.call(-1)
  list(inner, outer)
}

print(foo())
#[[1]]
#foo()
#[[2]]
#print(foo())

然而,help("sys.call") 是这样说的(强调我的):

Strictly, sys.parent and parent.frame refer to the context of the parent interpreted function. So internal functions (which may or may not set contexts and so may or may not appear on the call stack) may not be counted, and S3 methods can also do surprising things.

<-就是这样一个"internal function":

`<-`
#.Primitive("<-")

`<-`(x, foo())
x
#[[1]]
#foo()
#
#[[2]]
#NULL

正如 Roland 指出的那样,<- 在您的函数范围之外,只能通过查看函数调用堆栈来定位,但这失败了。因此,一个可能的解决方案是重新定义 '<-' else 而不是原始类型,或者更好的是,定义一些可以完成相同工作和其他功能的东西。 我不知道下面的代码背后的想法是否能满足你的需要,但你可以定义一个 "verbose assignation" :

`:=` <- function (var, value) 
{
    call = as.list(match.call())
    message(sprintf("Assigning %s to %s.\n",deparse(call$value),deparse(call$var)))
    eval(substitute(var <<- value))
    return(invisible(value))
 }

x := 1:10
# Assigning 1:10 to x.
x
# [1]  1  2  3  4  5  6  7  8  9 10

它在 '<-' 不是真正赋值的其他一些情况下也有效:

y <- data.frame(c=1:3)
colnames(y) := "b"
# Assigning "b" to colnames(y).
y
#  b
#1 1
#2 2
#3 3

z <- 1:4
dim(z) := c(2,2)
#Assigning c(2, 2) to dim(z).
z
#     [,1] [,2]
#[1,]    1    3
#[2,]    2    4

>

我认为这并非完全可行,正如其他解决方案所解释的那样,合理的替代方案可能是 Yosi 的回答。

但是我们可以从一些想法中获得乐趣,从简单开始,逐渐变得疯狂。


1 - 定义一个看起来相似的中缀运算符

`%<-add_str%` <- function(e1, e2) {
  e2_ <- e2
  e1_ <- as.character(substitute(e1))
  eval.parent(substitute(e1 <- paste0(e1_,e2_)))
}

a %<-add_str% "b" 
a
# "ab"

2 - 重新定义 := 以便它通过 ..lhs() 函数

使 lhs 的名称对 rhs 可用

我认为这是我最喜欢的选项:

`:=` <- function(lhs,rhs){
  lhs_name <- as.character(substitute(lhs))
  assign(lhs_name,eval(substitute(rhs)), envir = parent.frame())
  lhs
}

..lhs <- function(){
  eval.parent(quote(lhs_name),2)
}

add_str <- function(x){
  res <- paste0(..lhs(),x)
  res
}

a := add_str("b")
a
# [1] "ab"

可能有一种方法可以基于此重新定义<-,但由于递归问题我无法弄清楚。


3 - 使用内存地址黑魔法来寻找 lhs(如果存在)

这直接来自:Get name of x when defining `(<-` operator

为此,我们需要稍微更改语法并定义函数 fetch_name,它能够从 *<- 函数中获取 rhs 的名称,其中 as.character(substitute(lhs)) 会 return "*tmp*".

fetch_name <- function(x,env = parent.frame(2)) {
  all_addresses       <- sapply(ls(env), pryr:::address2, env)
  all_addresses       <- all_addresses[names(all_addresses) != "*tmp*"]
  all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\2",all_addresses)

  x_address       <- tracemem(x)
  untracemem(x)
  x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\2",x_address))

  ind    <- match(x_address_short, all_addresses_short)
  x_name <- names(all_addresses)[ind]
  x_name
}

`add_str<-` <- function(x,value){
  x_name <- fetch_name(x)
  paste0(x_name,value)
}

a <- NA
add_str(a) <- "b"
a

4- 后者的变体,使用.Last.value :

add_str <- function(value){
  x_name <- fetch_name(.Last.value)
  assign(x_name,paste0(x_name,value),envir = parent.frame())
  paste0(x_name,value)
}

a <- NA;add_str("b")
a
# [1] "ab"

操作不需要在同一行上,但它们需要相互跟随。


5 - 又是一个变体,使用打印方法 hack

非常肮脏和令人费解,取悦受折磨的灵魂并控制其他人。

这是唯一一个真正给出预期输出的方法,但它只能在交互模式下工作。

诀窍在于,我没有在第一个操作中完成所有工作,而是还使用了第二个操作(打印)。所以第一步我return一个值为"b"的对象,但是我也给它赋了一个class"weird"和一个打印方法,然后打印方法修改了对象的值,重置其 class,并销毁自身。

add_str <- function(x){
  class(x) <- "weird"
  assign("print.weird", function(x) {
    env <- parent.frame(2)
    x_name <- fetch_name(x, env)
    assign(x_name,paste0(x_name,unclass(x)),envir = env)
    rm(print.weird,envir = env)
    print(paste0(x_name,x))
  },envir = parent.frame())
  x
}

a <- add_str("b")
a
# [1] "ab"

(a <- add_str("b") 与上面两行的效果相同。 print(a <- add_str("b")) 也有同样的效果,但也适用于非交互式代码。