Comment implémenter efficacement la coalescence dans R
Contexte
Plusieurs langages SQL (j'utilise principalement postgreSQL) ont une fonction appelée coalesce qui renvoie le premier élément de colonne non nul pour chaque ligne. Cela peut être très efficace lorsque les tables contiennent beaucoup d'éléments NULL.
Je rencontre ce problème dans de nombreux scénarios dans R également lorsqu'il s'agit de données non structurées contenant beaucoup d'AN.
J'ai moi-même fait une mise en œuvre naïve mais elle est ridiculement lente.
coalesce <- function(...) {
apply(cbind(...), 1, function(x) {
x[which(!is.na(x))[1]]
})
}
Exemple
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
Question
Existe-t-il un moyen efficace de mettre en œuvre coalesce dans R?
Sur ma machine, l'utilisation de Reduce procure une amélioration de 5 fois des performances:
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
On dirait que coalesce1 est toujours disponible
coalesce1 <- function(...) {
ans <- ..1
for (elt in list(...)[-1]) {
i <- is.na(ans)
ans[i] <- elt[i]
}
ans
}
ce qui est encore plus rapide (mais plus ou moins une réécriture de Reduce, donc moins générale)
> 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
Ou pour des données plus grandes, comparez
coalesce1a <- function(...) {
ans <- ..1
for (elt in list(...)[-1]) {
i <- which(is.na(ans))
ans[i] <- elt[i]
}
ans
}
montrer que which() peut parfois être efficace, même si cela implique un second passage dans l'index.
> 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
Utiliser dplyr package:
library(dplyr)
coalesce(a, b, c)
# [1] 1 2 NA 4 6
Benchamark, pas aussi vite que la solution acceptée:
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
Mais sur un plus grand ensemble de données, il est 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
J'ai une implémentation prête à l'emploi appelée coalesce.na dans mon paquetage misc . Il semble être compétitif, mais pas le plus rapide . Il fonctionnera également pour les vecteurs de longueur différente, et dispose d'un traitement spécial pour les vecteurs de longueur un
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
Voici le 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
}
Bien sûr, comme l'a souligné Kevin, une solution Rcpp pourrait être plus rapide par ordre de grandeur.
Une autre méthode, avec mapply.
mapply(function(...) {temp <- c(...); temp[!is.na(temp)][1]}, a, b, c)
[1] 1 2 NA 4 6
Ceci sélectionne la première valeur non-NA s'il en existe plusieurs. Le dernier élément non manquant peut être sélectionné avec tail.
Peut-être qu'un peu plus de vitesse pourrait être évité grâce à la fonction bare bones .mapply, qui est légèrement différente.
unlist(.mapply(function(...) {temp <- c(...); temp[!is.na(temp)][1]},
dots=list(a, b, c), MoreArgs=NULL))
[1] 1 2 NA 4 6
.mapplydiffers de manière importante de son cousin non en pointillé.
- il retourne une liste (comme
Map) et doit donc être encapsulé dans une fonction telle queunlistoucpour renvoyer un vecteur. - l'ensemble des arguments à alimenter parallèlement à la fonction dans FUN doit être donné dans une liste à l'argument points.
- Enfin,
mapply, l'argument moreArgs n'a pas de valeur par défaut et doit donc être explicitement alimenté NULL.
Une solution simple very consiste à utiliser la fonction ifelse du package base:
coalesce3 <- function(x, y) {
ifelse(is.na(x), y, x)
}
Bien qu'il semble être plus lent que coalesce2 ci-dessus:
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
Vous pouvez utiliser Reduce pour le faire fonctionner pour un nombre arbitraire de vecteurs:
coalesce4 <- function(...) {
Reduce(coalesce3, list(...))
}