Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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.

like image 552
Wart Avatar asked Sep 13 '17 18:09

Wart


2 Answers

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.

like image 152
Moody_Mudskipper Avatar answered Nov 05 '22 23:11

Moody_Mudskipper


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
like image 40
Roland Avatar answered Nov 06 '22 01:11

Roland