R:函数如何使用省略号(...)接受变量参数而不将其复制到内存中？

Question

[编辑:提示此解决方法的问题已从R 3.1.0开始修复.]

我被问到其他地方发布这是一个自我回答的问题.

当R函数通过省略号参数接受任意数量的参数时,访问它们的常用方法是使用list(...):

f <- function(...) {
  dots <- list(...)

  # Let's print them out.
  for (i in seq_along(dots)) {
    cat(i, ": name=", names(dots)[i], "\n", sep="")
    print(dots[[i]])
  }
}

> f(10, a=20)
1: name=
[1] 10
2: name=a
[1] 20

但是,R(截至v3.0.2)深层复制了所有list元素:

> x <- 10
> .Internal(inspect(x))
@10d85ca68 14 REALSXP g0c1 [MARK,NAM(2),TR] (len=1, tl=0) 10

> x2 <- x
> .Internal(inspect(x2))  # Not copied.
@10d85ca68 14 REALSXP g0c1 [MARK,NAM(2),TR] (len=1, tl=0) 10

> y <- list(x)
> .Internal(inspect(y[[1]]))  # x was copied to a different address:
@10dd45e88 14 REALSXP g0c1 [MARK,NAM(1),TR] (len=1, tl=0) 10

> z <- list(y)
> .Internal(inspect(z))  # y was deep-copied:
@10d889ed8 19 VECSXP g0c1 [MARK,NAM(1)] (len=1, tl=0)
  @10d889f38 19 VECSXP g0c1 [MARK,TR] (len=1, tl=0)
    @10d889f68 14 REALSXP g0c1 [MARK] (len=1, tl=0) 10

tracemem如果启用了内存分析,也可以验证这一点.

所以你一直在存储大型物体list？复制.将它们传递给任何调用list(...)内部的函数？复制:

> g <- function(...) for (x in list(...)) .Internal(inspect(x))
> g(z)  # Copied.
@10dd45e58 19 VECSXP g0c1 [] (len=1, tl=0)
  @10dd35fa8 19 VECSXP g0c1 [] (len=1, tl=0)
    @10dd36068 19 VECSXP g0c1 [] (len=1, tl=0)
      @10dd36158 14 REALSXP g0c1 [] (len=1, tl=0) 10
> g(z)  # ...copied again.
@10dd32268 19 VECSXP g0c1 [] (len=1, tl=0)
  @10d854c68 19 VECSXP g0c1 [] (len=1, tl=0)
    @10d8548d8 19 VECSXP g0c1 [] (len=1, tl=0)
      @10d8548a8 14 REALSXP g0c1 [] (len=1, tl=0) 10

没吓坏了吗？尝试grep -l "list(\.\.\.)" *.R使用R库源代码.我最喜欢的是mapply/ Map,我经常调用GB数据,并想知道为什么内存耗尽.至少没问题lapply.

那么,如何用...参数编写一个可变参数函数并避免复制它们呢？

Answer 1

我们可以...使用扩展参数match.call,然后评估并存储environment不会复制值的参数.由于environment对象需要所有元素的名称而不保留它们的顺序,因此除了(可选的)形式参数名称之外,我们还需要存储一个单独的有序标记名称向量.这里使用属性实现:

argsenv <- function(..., parent=parent.frame()) {
  cl <- match.call(expand.dots=TRUE)

  e <- new.env(parent=parent)
  pf <- parent.frame()
  JJ <- seq_len(length(cl) - 1)
  tagnames <- sprintf(".v%d", JJ)
  for (i in JJ) e[[tagnames[i]]] <- eval(cl[[i+1]], envir=pf)

  attr(e, "tagnames") <- tagnames
  attr(e, "formalnames") <- names(cl)[-1]
  class(e) <- c("environment", "argsenv")
  e
}

现在我们可以在我们的函数中使用它而不是list(...):

f <- function(...) {
  dots <- argsenv(...)

  # Let's print them out.
  for (i in seq_along(attr(dots, "tagnames"))) {
    cat(i, ": name=", attr(dots, "formalnames")[i], "\n", sep="")
    print(dots[[attr(dots, "tagnames")[i]]])
  }
}

> f(10, a=20)
1: name=
[1] 10
2: name=a
[1] 20

它有效,但它是否避免复制？

g1 <- function(...) {
  dots <- list(...)
  for (x in dots) .Internal(inspect(x))
}

> z <- 10
> .Internal(inspect(z))
@10d854908 14 REALSXP g0c1 [NAM(2)] (len=1, tl=0) 10
> g1(z)
@10dcdaba8 14 REALSXP g0c1 [NAM(2)] (len=1, tl=0) 10
> g1(z, z)
@10dcbb558 14 REALSXP g0c1 [NAM(2)] (len=1, tl=0) 10
@10dcd53d8 14 REALSXP g0c1 [NAM(2)] (len=1, tl=0) 10
> 

g2 <- function(...) {
   dots <- argsenv(...);
   for (x in attr(dots, "tagnames")) .Internal(inspect(dots[[x]]))
}

> .Internal(inspect(z))
@10d854908 14 REALSXP g0c1 [MARK,NAM(2)] (len=1, tl=0) 10
> g2(z)
@10d854908 14 REALSXP g0c1 [MARK,NAM(2)] (len=1, tl=0) 10
> g2(z, z)
@10d854908 14 REALSXP g0c1 [MARK,NAM(2)] (len=1, tl=0) 10
@10d854908 14 REALSXP g0c1 [MARK,NAM(2)] (len=1, tl=0) 10

你可以在S4与插槽代替属性实现这一点,定义方法种种(length,[,[[,c,等)它,并把它变成一个成熟的通用非复制替代list.但这是另一篇文章.

旁注:您可以避免mapply/ Map通过重写所有这些调用lapply(seq_along(v1) function(i) FUN(v1[[i]], v2[[i]],... ),但这是很多工作,并且不会使您的代码在优雅和可读性方面受到任何好处.相反,我们可以使用和一些表达式操作重写mapply/ Mapfunctions argsenv来完成内部操作:

mapply2 <- function(FUN, ..., MoreArgs=NULL, SIMPLIFY=TRUE, USE.NAMES=TRUE) {
  FUN <- match.fun(FUN)

  args <- argsenv(...)
  tags <- attr(args, "tagnames")
  iexpr <- quote(.v1[[i]])
  iargs <- lapply(tags, function(x) { iexpr[[2]] <- as.name(x); iexpr })
  names(iargs) <- attr(args, "formalnames")
  iargs <- c(iargs, as.name("..."))
  icall <- quote(function(i, ...) FUN())[-4]
  icall[[3]] <- as.call(c(quote(FUN), iargs))
  ifun <- eval(icall, envir=args)

  lens <- sapply(tags, function(x) length(args[[x]]))
  maxlen <- if (length(lens) == 0) 0 else max(lens)
  if (any(lens != maxlen)) stop("Unequal lengths; recycle not implemented")

  answer <- do.call(lapply, c(list(seq_len(maxlen), ifun), MoreArgs))

  # The rest is from the original mapply code.

  if (USE.NAMES && length(tags)) {
    arg1 <- args[[tags[1L]]]
    if (is.null(names1 <- names(arg1)) && is.character(arg1)) names(answer) <- arg1
    else if (!is.null(names1)) names(answer) <- names1
  }

  if (!identical(SIMPLIFY, FALSE) && length(answer)) 
      simplify2array(answer, higher = (SIMPLIFY == "array"))
  else answer
}

# Original Map code, but calling mapply2 instead.
Map2 <- function (f, ...) {
  f <- match.fun(f)
  mapply2(FUN=f, ..., SIMPLIFY=FALSE)
}

你甚至可以为它们命名mapply/ Map在你的包/全局命名空间暗影的base版本,而不必修改代码的其余部分.这里的实现仅缺少不等长的回收功能,如果您愿意,可以添加.