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

还不害怕？在 R 库源代码中尝试 grep -l "list(\.\.\.)" *.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 的成熟通用非复制替代品。但那是另一篇文章。

旁注：您可以通过将所有此类调用重写为lapply(seq_along(v1) function(i) FUN(v1[[i]], v2[[i]],...) 来避免mapply/Map，但这需要大量工作，并且不会使您的代码在优雅和可读性。相反，我们可以重写 mapply/Map 函数，使用 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 版本，而不必修改其余代码。这里的实现只是缺少了不等长回收功能，如果您愿意，可以添加。