Подтвердить что ты не робот

R: Как функция может принимать переменные аргументы с использованием эллипса (...) без копирования их в память?

[РЕДАКТИРОВАТЬ: проблема, связанная с этим обходным решением, была исправлена ​​с R 3.1.0.]

Меня попросили в другом месте опубликовать это как вопрос, ответ на который я ответил.

Когда функция R принимает произвольное количество параметров через многоточие аргументов, общий способ доступа к ним - это использовать list(...):

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

  # Let 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 (по версии 3.0) полностью копирует все элементы 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, который я регулярно вызывал на ГБ данных и задавался вопросом, почему память заканчивается. По крайней мере, lapply отлично.

Итак, как я могу написать переменную функцию с аргументами ... и не копировать их?

4b9b3361

ОТВЕТЫ

Ответ 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 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/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 и не нужно изменять остальную часть вашего кода. Реализация здесь только пропускает неравномерную функцию переустановки длины, которую вы могли бы добавить, если хотите.