How do I access the name of the variable assigned

2019-01-25 14:13发布

问题:

For example, suppose I would like to be able to define a function that returned the name of the assignment variable concatenated with the first argument:

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

The function in the example above would look something like this:

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

but where the arg0 line of the function is replaced by a line that will get the name of the variable being assigned ("a") rather than the name of the function.

I've tried messing around with match.call and sys.call, but I can't get it to work. The idea here is that the assignment operator is being called on the variable and the function result, so that should be the parent call of the function call.

回答1:

I think that it's not strictly possible, as other solutions explained, and the reasonable alternative is probably Yosi's answer.

However we can have fun with some ideas, starting simple and getting crazier gradually.


1 - define an infix operator that looks similar

`%<-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 - Redefine := so that it makes available the name of the lhs to the rhs through a ..lhs() function

I think it's my favourite option :

`:=` <- 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"

There might be a way to redefine <- based on this, but I couldn't figure it out due to recursion issues.


3 - Use memory address dark magic to hunt lhs (if it exists)

This comes straight from: Get name of x when defining `(<-` operator

We'll need to change a bit the syntax and define the function fetch_name for this purpose, which is able to get the name of the rhs from a *<- function, where as.character(substitute(lhs)) would 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- a variant of the latter, using .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"

Operations don't need to be on the same line, but they need to follow each other.


5 - Again a variant, using a print method hack

Extremely dirty and convoluted, to please the tortured spirits and troll the others.

This is the only one that really gives the expected output, but it works only in interactive mode.

The trick is that instead of doing all the work in the first operation I also use the second (printing). So in the first step I return an object whose value is "b", but I also assigned a class "weird" to it and a printing method, the printing method then modifies the object's value, resets its class, and destroys itself.

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") will have the same effect as both lines above. print(a <- add_str("b")) would also have the same effect but would work in non interactive code, as well.



回答2:

This is generally not possible because the operator <- is actually parsed to a call of the <- function:

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"

Now, you can access earlier calls on the call stack by passing negative numbers to sys.call, e.g.,

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

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

However, help("sys.call") says this (emphasis mine):

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.

<- is such an "internal function":

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

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


回答3:

I don't think the function has access to the variable it is being assigned to. It is outside of the function scope and you do not pass any pointer to it or specify it in any way. If you were to specify it as a parameter, you could do something like this:

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

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


回答4:

As Roland pointed, the <- is outside of the scope of your function and could only be located looking at the stack of function calls, but this fail. So a possible solution could be to redefine the '<-' else than as a primitive or, better, to define something that does the same job and additional things too. I don't know if the ideas behind following code can fit your needs, but you can define a "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

And it works in some other situation where the '<-' is not really an assignation :

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

>