web-dev-qa-db-de.com

Wie lässt sich Coalesce effizient in R implementieren?

Hintergrund

Mehrere SQL-Sprachen (meistens verwende ich postgreSQL) haben eine Funktion namens coalesce, die das erste nicht-null-Spaltenelement für jede Zeile zurückgibt. Dies kann sehr effizient sein, wenn Tabellen viele NULL-Elemente enthalten. 

Ich begegne dem in vielen Szenarien in R ebenso wie beim Umgang mit nicht so strukturierten Daten, die viele NA enthalten. 

Ich habe selbst eine naive Implementierung gemacht, aber es ist lächerlich langsam. 

coalesce <- function(...) {
  apply(cbind(...), 1, function(x) {
          x[which(!is.na(x))[1]]
        })
}

Beispiel

a <- c(1,  2,  NA, 4, NA)
b <- c(NA, NA, NA, 5, 6)
c <- c(7,  8,  NA, 9, 10)
coalesce(a,b,c)
# [1]  1  2 NA  4  6

Frage

Gibt es eine effiziente Möglichkeit, coalesce in R zu implementieren?

33
while

Die Verwendung von Reduce bringt auf meinem Computer eine 5-fache Leistungsverbesserung:

coalesce2 <- function(...) {
  Reduce(function(x, y) {
    i <- which(is.na(x))
    x[i] <- y[i]
    x},
  list(...))
}

> microbenchmark(coalesce(a,b,c),coalesce2(a,b,c))
Unit: microseconds
               expr    min       lq   median       uq     max neval
  coalesce(a, b, c) 97.669 100.7950 102.0120 103.0505 243.438   100
 coalesce2(a, b, c) 19.601  21.4055  22.8835  23.8315  45.419   100
35
mrip

Es sieht so aus, als ob coalesce1 noch verfügbar ist

coalesce1 <- function(...) {
    ans <- ..1
    for (elt in list(...)[-1]) {
        i <- is.na(ans)
        ans[i] <- elt[i]
    }
    ans
}

was noch schneller ist (aber mehr oder weniger eine Hand von Reduce neu schreiben, also weniger allgemein)

> identical(coalesce(a, b, c), coalesce1(a, b, c))
[1] TRUE
> microbenchmark(coalesce(a,b,c), coalesce1(a, b, c), coalesce2(a,b,c))
Unit: microseconds
               expr     min       lq   median       uq     max neval
  coalesce(a, b, c) 336.266 341.6385 344.7320 355.4935 538.348   100
 coalesce1(a, b, c)   8.287   9.4110  10.9515  12.1295  20.940   100
 coalesce2(a, b, c)  37.711  40.1615  42.0885  45.1705  67.258   100

Oder für größere Daten vergleichen

coalesce1a <- function(...) {
    ans <- ..1
    for (elt in list(...)[-1]) {
        i <- which(is.na(ans))
        ans[i] <- elt[i]
    }
    ans
}

zeigt, dass which() manchmal effektiv sein kann, auch wenn ein zweiter Durchlauf durch den Index impliziert wird.

> aa <- sample(a, 100000, TRUE)
> bb <- sample(b, 100000, TRUE)
> cc <- sample(c, 100000, TRUE)
> microbenchmark(coalesce1(aa, bb, cc),
+                coalesce1a(aa, bb, cc),
+                coalesce2(aa,bb,cc), times=10)
Unit: milliseconds
                   expr       min        lq    median        uq       max neval
  coalesce1(aa, bb, cc) 11.110024 11.137963 11.145723 11.212907 11.270533    10
 coalesce1a(aa, bb, cc)  2.906067  2.953266  2.962729  2.971761  3.452251    10
  coalesce2(aa, bb, cc)  3.080842  3.115607  3.139484  3.166642  3.198977    10
18
Martin Morgan

Verwenden Sie dplyr package:

library(dplyr)
coalesce(a, b, c)
# [1]  1  2 NA  4  6

Benchamark, nicht so schnell wie akzeptierte Lösung:

coalesce2 <- function(...) {
  Reduce(function(x, y) {
    i <- which(is.na(x))
    x[i] <- y[i]
    x},
    list(...))
}

microbenchmark::microbenchmark(
  coalesce(a, b, c),
  coalesce2(a, b, c)
)

# Unit: microseconds
#                expr    min     lq     mean median      uq     max neval cld
#   coalesce(a, b, c) 21.951 24.518 27.28264 25.515 26.9405 126.293   100   b
#  coalesce2(a, b, c)  7.127  8.553  9.68731  9.123  9.6930  27.368   100  a 

Bei einem größeren Datensatz ist es jedoch vergleichbar:

aa <- sample(a, 100000, TRUE)
bb <- sample(b, 100000, TRUE)
cc <- sample(c, 100000, TRUE)

microbenchmark::microbenchmark(
  coalesce(aa, bb, cc),
  coalesce2(aa, bb, cc))

# Unit: milliseconds
#                   expr      min       lq     mean   median       uq      max neval cld
#   coalesce(aa, bb, cc) 1.708511 1.837368 5.468123 3.268492 3.511241 96.99766   100   a
#  coalesce2(aa, bb, cc) 1.474171 1.516506 3.312153 1.957104 3.253240 91.05223   100   a
13
zx8754

Ich habe eine gebrauchsfertige Implementierung namens coalesce.na in my misc package . Es scheint konkurrenzfähig zu sein, aber nicht am schnellsten ..__ Es funktioniert auch für Vektoren unterschiedlicher Länge und hat eine spezielle Behandlung für Vektoren der Länge eins:

                    expr        min          lq      median          uq         max neval
    coalesce(aa, bb, cc) 990.060402 1030.708466 1067.000698 1083.301986 1280.734389    10
   coalesce1(aa, bb, cc)  11.356584   11.448455   11.804239   12.507659   14.922052    10
  coalesce1a(aa, bb, cc)   2.739395    2.786594    2.852942    3.312728    5.529927    10
   coalesce2(aa, bb, cc)   2.929364    3.041345    3.593424    3.868032    7.838552    10
 coalesce.na(aa, bb, cc)   4.640552    4.691107    4.858385    4.973895    5.676463    10

Hier ist der Code:

coalesce.na <- function(x, ...) {
  x.len <- length(x)
  ly <- list(...)
  for (y in ly) {
    y.len <- length(y)
    if (y.len == 1) {
      x[is.na(x)] <- y
    } else {
      if (x.len %% y.len != 0)
        warning('object length is not a multiple of first object length')
      pos <- which(is.na(x))
      x[pos] <- y[(pos - 1) %% y.len + 1]
    }
  }
  x
}

Natürlich, wie Kevin betonte, könnte eine Rcpp-Lösung um Größenordnungen schneller sein.

9
krlmlr

Von data.table >= 1.12.3 Sie können coalesce verwenden.

library(data.table)
coalesce(a, b, c)
# [1]  1  2 NA  4  6

Weitere Informationen, einschließlich eines Benchmarks, finden Sie unter NEWS-Artikel Nr. 18 für Entwicklungsversion 1.12. . Informationen zur Installation der Entwicklungsversion finden Sie unter hier .

3
Henrik

Hier ist meine Lösung:

coalesce <- function(x){ y <- head( x[is.na(x) == F] , 1) return(y) } Gibt den ersten Wert zurück, der nicht NA ist, und funktioniert mit data.table. Wenn Sie beispielsweise Coalesce für einige Spalten verwenden möchten und die folgenden Spaltennamen in Vektorzeichenfolgen vorliegen:

column_names <- c("col1", "col2", "col3")

wie benutzt man:

ranking[, coalesce_column := coalesce( mget(column_names) ), by = 1:nrow(ranking)]

2
Taz

Eine andere Apply-Methode mit mapply.

mapply(function(...) {temp <- c(...); temp[!is.na(temp)][1]}, a, b, c)
[1]  1  2 NA  4  6

Dadurch wird der erste Nicht-NA-Wert ausgewählt, wenn mehr als einer vorhanden ist. Das letzte nicht fehlende Element kann mit tail ausgewählt werden.

Vielleicht könnte etwas mehr Geschwindigkeit aus dieser Alternative herausgedrückt werden, indem die .mapply-Funktion nackte Knochen verwendet wird, die etwas anders aussieht.

unlist(.mapply(function(...) {temp <- c(...); temp[!is.na(temp)][1]},
               dots=list(a, b, c), MoreArgs=NULL))
[1]  1  2 NA  4  6

.mapply unterscheidet sich in wichtigen Punkten von seinem nicht gepunkteten Cousin.

  • es gibt eine Liste zurück (wie Map) und muss daher in eine Funktion wie unlist oder c eingeschlossen werden, um einen Vektor zurückzugeben.
  • die Menge der Argumente, die parallel zur Funktion in FUN eingegeben werden sollen, muss dem dots-Argument in einer Liste angegeben werden.
  • Schließlich hat mapply das Argument moreArgs keinen Standardwert, daher muss es explizit NULL sein.
1
lmo

Eine einfache Lösung von very ist die Verwendung der ifelse-Funktion aus dem base-Paket: 

coalesce3 <- function(x, y) {

    ifelse(is.na(x), y, x)
}

Obwohl es langsamer zu sein scheint als coalesce2 oben: 

test <- function(a, b, func) {

    for (i in 1:10000) {

        func(a, b)
    }
}

system.time(test(a, b, coalesce2))
user  system elapsed 
0.11    0.00    0.10 

system.time(test(a, b, coalesce3))
user  system elapsed 
0.16    0.00    0.15 

Sie können Reduce verwenden, damit es für eine beliebige Anzahl von Vektoren funktioniert: 

coalesce4 <- function(...) {

    Reduce(coalesce3, list(...))
}
0
sdgfsdh