studio - superponer graficas en r

Cómo implementar la fusión de manera eficiente en R

Question

Fondo

Varios lenguajes SQL (utilizo principalmente postgreSQL) tienen una función llamada coalesce que devuelve el primer elemento de columna no nulo para cada fila. Esto puede ser muy eficiente de usar cuando las tablas tienen muchos elementos NULL en ellos.

Me encuentro con esto en muchos escenarios en R también cuando trato con datos no tan estructurados que tienen muchas NA en ellos.

He realizado una implementación ingenua pero es ridículamente lenta.

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

Ejemplo

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

Pregunta

¿Hay alguna manera eficiente de implementar la coalesce en R?

Answer 1

Aquí está mi solución:

coalesce <- function(x){ y <- head( x[is.na(x) == F] , 1) return(y) } Devuelve el primer vaule que no es NA y funciona en data.table , para ejemplo si desea usar coalesce en pocas columnas y estos nombres de columna están en el vector de cadenas:

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

cómo utilizar:

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

Answer 2

En mi máquina, al usar Reduce obtiene una mejora de rendimiento de 5x:

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

Answer 3

Otro método de aplicación, con mapply .

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

Esto selecciona el primer valor distinto de NA si existe más de uno. El último elemento no perdido se puede seleccionar usando tail .

Tal vez un poco más de velocidad podría ser exprimido de esta alternativa usando la .mapply función .mapply , que se ve un poco diferente.

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

.mapply difiere de manera importante de su primo no punteado.

• devuelve una lista (como Map ) y por lo tanto debe estar envuelto en alguna función como unlist o c para devolver un vector.
• el conjunto de argumentos que se debe alimentar en paralelo a la función en FUN se debe dar en una lista al argumento de puntos.
• Finalmente, mapply , el argumento moreArgs no tiene un valor predeterminado, por lo que debe alimentarse explícitamente con NULL.

Answer 4

Parece que coalesce1 todavía está disponible

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

que es aún más rápido (pero más o menos una reescritura de la mano de Reduce , por lo tanto, menos general)

> 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

O para comparar datos más grandes

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

mostrando aquello which() veces puede ser efectivo, aunque implique un segundo pase a través del índice.

> 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

Answer 5

Tengo una implementación lista para usar llamada coalesce.na en mi paquete misceláneo . Parece ser competitivo, pero no el más rápido. También funcionará para vectores de diferente longitud, y tiene un tratamiento especial para vectores de longitud uno:

                    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

Aquí está el código:

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
}

Por supuesto, como señaló Kevin, una solución de Rcpp podría ser más rápida por órdenes de magnitud.

Answer 6

Una solución muy simple es usar la función ifelse del paquete base :

coalesce3 <- function(x, y) {

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

Aunque parece ser más lento que coalesce2 anterior:

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 

Puede usar Reduce para que funcione para una cantidad arbitraria de vectores:

coalesce4 <- function(...) {

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

Answer 7

Usando el paquete dplyr :

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

Benchamark, no tan rápido como la solución aceptada:

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 

Pero en un conjunto de datos más grande, es comparable:

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