R: Wie kann eine Funktion variable Argumente mit Ellipsen (...) akzeptieren, ohne sie in den Speicher zu kopieren?

Question

[EDIT:. Das Problem Auffordern diese Abhilfe, da R 3.1.0 behoben wurde]

Ich wurde an anderer Stelle gebeten, dies als selbst beantworteten Frage zu stellen.

Wenn eine R-Funktion eine beliebige Anzahl von Parametern durch die Auslassungs Argumente akzeptiert, der gemeinsame Weg, um sie für den Zugriff verwendet 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 

jedoch R (ab v3.0.2) tief kopiert alle list Elemente:

> 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 

Sie können dies auch mit tracemem überprüfen, ob Sie Speicherprofilerstellung aktiviert haben.

Sie haben also große Objekte in einem list gespeichert? Kopiert. Übergeben Sie sie in jede Funktion, die list(...) innen aufruft? Kopiert:

> 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 

Noch nicht entsetzt? Versuchen Sie grep -l "list(\.\.\.)" *.R in R-Bibliothek Quellen. Mein Favorit ist mapply/Map, von dem ich routinemäßig GBs von Daten anrief und mich fragte, warum der Speicher knapp wurde. Mindestens lapply ist in Ordnung.

Also, wie kann ich eine variadic Funktion mit ... Argumente schreiben und vermeiden, sie zu kopieren?

Answer 1

Wir können ... Argumente mit match.call erweitern und dann auswerten und die Argumente in einem environment speichern, die die Werte nicht kopiert. Da environment Objekte Namen für alle Elemente erfordern und ihre Reihenfolge nicht beibehalten, müssen wir zusätzlich zu den (optionalen) formalen Argumentnamen einen separaten Vektor von geordneten Tag-Namen speichern. Umgesetzt hier mithilfe von Attributen:

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 
} 

Jetzt können wir es in unseren Funktionen anstelle von 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 

So funktioniert es, aber ist es das Kopieren vermeiden?

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 

Sie diese mit Schlitzen anstelle von Attributen in S4 implementieren könnte, alle möglichen Methoden definieren (length, [, [[, c, etc.) für sie, und macht es zu einem vollwertigen Allzweck- Kopierfreier Ersatz für list. Aber das ist ein weiterer Beitrag.

Randbemerkung: Sie können durch Umschreiben alle solche Anrufe als lapply(seq_along(v1) function(i) FUN(v1[[i]], v2[[i]], ... ), mapply/Map vermeiden, aber das ist eine Menge Arbeit, und tut nicht, Ihren Code keinen Gefallen an Eleganz und Lesbarkeit.Stattdessen können wir die mapply/Map Funktionen umschreiben argsenv und einige Ausdruck Manipulation mit genau das Innere zu tun:

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) 
} 

Sie sogar nennen könnte mapply/Map in Ihrem Paket/globalen Namensraum die base Versionen beschatten und nicht muss den Rest Ihres Codes ändern. Der Implementierung fehlt hier nur die Recyling-Funktion ungleicher Länge, die Sie bei Bedarf hinzufügen könnten.