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

Question

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

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,但我无法让它工作.这里的想法是在变量和函数结果上调用赋值运算符,因此应该是函数调用的父调用.

Answer 1

我认为这不是严格可能的,正如其他解决方案所解释的那样,合理的替代方案可能是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()函数为rhs提供lhs的名称

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

`:=` <- 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(如果存在)

这直接来自:定义`(< - `运算符时)获取x的名称

我们需要改变一点语法并fetch_name为此目的定义函数,它能够从*<- 函数中获取rhs的名称,as.character(substitute(lhs))返回的位置"*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的变体

非常肮脏和令人费解,以取悦受折磨的精神和其他人.

这是唯一真正提供预期输出的产品,但它仅适用于交互模式.

诀窍是,我没有在第一次操作中完成所有工作,而是使用第二次操作(打印).因此,在第一步中,我返回一个值为的对象"b",但是我还"weird"为它分配了一个类和一个打印方法,然后打印方法修改了对象的值,重置了它的类,并自行销毁.

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"))也会产生相同的效果,但也适用于非交互式代码.

Answer 2

通常这是不可能的，因为<-实际上会将运算符解析为该<-函数的调用：

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")说（强调我的意思）：

严格地，sys.parent和parent.frame引用父解释函数的上下文。因此，内部函数（可能会或可能不会设置上下文，因此可能会或可能不会出现在调用堆栈中）可能不计算在内，并且S3方法也可以做令人惊讶的事情。

<- 是这样的“内部功能”：

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

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