用于获取变量引用的R函数

在中，环境被宣传为在R中获取按引用传递语义的有用方法：我可以传递一个环境，而不是传递一个被复制的列表。了解这一点很有用

但它假设调用我的函数的人都乐于同意基于“环境”的数据类型，命名槽对应于我们要修改的变量

难道没有人创建了一个类，允许我通过引用引用单个变量吗？比如说,

v = 1:5
r <- ref(v)
(function() {
    getRef(r)       # same as v
    setRef(r, 1:6)  # same as v <<- 1:6, in this case
})()

v=1:5
r正如您在问题中已经提到的，您可以存储变量名及其环境，并使用
get
和
assign
访问它，这类似于对单个变量的引用

这是基于GKi的回答，感谢他的支持


它包括pryr:：where，因此您不必安装整个库
注意，我们需要在“ref”的定义中将“where”指向
parent.frame（）
添加了一些我用来检查正确性的测试用例

守则：

# copy/modified from pryr::where
where = function(name, env=parent.frame()) {
  if (identical(env, emptyenv())) {
    stop("Can't find ", name, call. = FALSE)
  }
  if (exists(name, env, inherits = FALSE)) {
    env
  } else {
    where(name, parent.env(env))
  }
}

ref <- function(v) {
  arg <- deparse(substitute(v))
  list(name=arg, env=where(arg, env=parent.frame()))
}

getRef <- function(r) {
  get(r$name, envir = r$env, inherits = FALSE)
}

setRef <- function(r, x) {
  assign(r$name, x, envir = r$env)
}

if(1) { # tests
  v <- 1:5
  r <- ref(v)
  (function() {
    stopifnot(identical(getRef(r),1:5))
    setRef(r, 1:6)
  })()
  stopifnot(identical(v,1:6))

  # this refers to v in the global environment
  v=2; r=(function() {ref(v)})()
  stopifnot(getRef(r)==2)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==5)

  # same as above
  v=2; r=(function() {v <<- 3; ref(v)})()
  stopifnot(getRef(r)==3)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==5)

  # this creates a local binding first, and refers to that. the
  # global binding is unaffected
  v=2; r=(function() {v=3; ref(v)})()
  stopifnot(getRef(r)==3)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==2)

  # additional tests
  r=(function() {v=4; (function(v1) { ref(v1) })(v)})()
  stopifnot(r$name=="v1")
  stopifnot(getRef(r)==4)
  setRef(r,5)
  stopifnot(getRef(r)==5)

  # check that outer v is not modified
  v=2; r=(function() {(function(v1) { ref(v1) })(v)})()
  stopifnot(getRef(r)==2)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==2)
}

#从pryr:：where复制/修改
其中=函数（名称，env=parent.frame（））{
if（相同（env，emptyenv（））{
stop（“找不到”、name、call.=FALSE）
}
if（存在（名称、环境、继承=FALSE））{
环境
}否则{
其中（名称，父环境（env））
}
}
ref什么是
setRef
和
getRef
？请添加所有相关代码。这本书将来可能会改变。因为你没有提到data.table包或R6类，我认为这些可能是有用的研究领域。看看吧，谢谢，我不知道as.environment（find（…）
实际上这里使用“find”是错误的，它在包中查找符号。我想我将只回答我自己的问题，因为它需要一些额外的努力才能使代码正常工作。当变量从存储环境中删除时，链接将指向parrent。Try:
v如何在环境中设置对变量的引用？例如，
a这是一个功能请求吗，就像您希望
ref
有一个可选参数来指定环境一样？但也许它还应该返回一个带有打印函数的类，等等。。。我认为这里的内容足以给出一个很好的答案。
v <- 1:5
r <- globalenv() #reference to everything in globalenv
(function() {
    r$v
    r$v <- 1:6
})()
v
#[1] 1 2 3 4 5 6

v <- new.env(parent=emptyenv())
v$v <- 1:5
r <- v
(function() {
    r$v
    r$v <- 1:6
})()
v$v
#[1] 1 2 3 4 5 6

ref <- function(name, envir = NULL) {
  name <- substitute(name)
  if (!is.character(name)) name <- deparse(name)
  if(length(envir)==0) envir <- as.environment(find(name))
  list(name=name, envir=envir)
}
getRef <- function(r) {
  get(r$name, envir = r$envir, inherits = FALSE)
}
setRef <- function(r, x) {
  assign(r$name, x, envir = r$envir, inherits = FALSE)
}

x <- 1
r1 <- ref(x) #x from Global Environment

#x from Function Environment
r2 <- (function() {x <- 2; ref(x, environment())})()
#But simply returning x might here be better
r2b <- (function() {x <- 2; x})()

a <- new.env(parent=emptyenv())
a$x <- 3
r3 <- ref(x, a) #x from Environment a

# copy/modified from pryr::where
where = function(name, env=parent.frame()) {
  if (identical(env, emptyenv())) {
    stop("Can't find ", name, call. = FALSE)
  }
  if (exists(name, env, inherits = FALSE)) {
    env
  } else {
    where(name, parent.env(env))
  }
}

ref <- function(v) {
  arg <- deparse(substitute(v))
  list(name=arg, env=where(arg, env=parent.frame()))
}

getRef <- function(r) {
  get(r$name, envir = r$env, inherits = FALSE)
}

setRef <- function(r, x) {
  assign(r$name, x, envir = r$env)
}

if(1) { # tests
  v <- 1:5
  r <- ref(v)
  (function() {
    stopifnot(identical(getRef(r),1:5))
    setRef(r, 1:6)
  })()
  stopifnot(identical(v,1:6))

  # this refers to v in the global environment
  v=2; r=(function() {ref(v)})()
  stopifnot(getRef(r)==2)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==5)

  # same as above
  v=2; r=(function() {v <<- 3; ref(v)})()
  stopifnot(getRef(r)==3)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==5)

  # this creates a local binding first, and refers to that. the
  # global binding is unaffected
  v=2; r=(function() {v=3; ref(v)})()
  stopifnot(getRef(r)==3)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==2)

  # additional tests
  r=(function() {v=4; (function(v1) { ref(v1) })(v)})()
  stopifnot(r$name=="v1")
  stopifnot(getRef(r)==4)
  setRef(r,5)
  stopifnot(getRef(r)==5)

  # check that outer v is not modified
  v=2; r=(function() {(function(v1) { ref(v1) })(v)})()
  stopifnot(getRef(r)==2)
  setRef(r,5)
  stopifnot(getRef(r)==5)
  stopifnot(v==2)
}