web-dev-qa-db-fra.com

Supprimer les lignes où toutes les variables sont NA en utilisant dplyr

J'ai des problèmes avec une tâche apparemment simple: supprimer toutes les lignes où toutes les variables sont NA en utilisant dplyr. Je sais que cela peut être fait en utilisant la base R ( Supprimer les lignes de la matrice R où toutes les données sont NA et Supprimer les lignes vides d'un fichier de données dans R ), mais je suis curieux de savoir s'il existe un moyen simple de le faire en utilisant dplyr.

Exemple:

library(tidyverse)
dat <- tibble(a = c(1, 2, NA), b = c(1, NA, NA), c = c(2, NA, NA))
filter(dat, !is.na(a) | !is.na(b) | !is.na(c))

L'appel filter ci-dessus fait ce que je veux mais c'est impossible dans la situation à laquelle je fais face (car il y a un grand nombre de variables). Je suppose que l'on pourrait le faire en utilisant filter_ Et en créant d'abord une chaîne avec l'instruction (longue) logique, mais il semble qu'il devrait y avoir un moyen plus simple.

Une autre façon consiste à utiliser rowwise() et do():

na <- dat %>% 
  rowwise() %>% 
  do(tibble(na = !all(is.na(.)))) %>% 
  .$na
filter(dat, na)

mais ça n'a pas l'air trop sympa, même si ça fait le boulot. D'autres idées?

rdplyrtidyverse
21
hejseb

Depuis dplyr 0.7.0, de nouveaux verbes de filtrage de portée existent. En utilisant filter_any, vous pouvez facilement filtrer les lignes avec au moins une colonne non manquante:

dat %>% filter_all(any_vars(!is.na(.)))

En utilisant l'algorithme de benchmarking @hejseb, il semble que cette solution soit aussi efficace que f4.

25
MarkusN

Analyse comparative

@DavidArenburg a suggéré un certain nombre d'alternatives. Voici une analyse comparative simple d'entre eux.

library(tidyverse)
library(microbenchmark)

n <- 100
dat <- tibble(a = rep(c(1, 2, NA), n), b = rep(c(1, 1, NA), n))

f1 <- function(dat) {
  na <- dat %>% 
    rowwise() %>% 
    do(tibble(na = !all(is.na(.)))) %>% 
    .$na
  filter(dat, na)
}

f2 <- function(dat) {
  dat %>% filter(rowSums(is.na(.)) != ncol(.))
}

f3 <- function(dat) {
  dat %>% filter(rowMeans(is.na(.)) < 1)
}

f4 <- function(dat) {
  dat %>% filter(Reduce(`+`, lapply(., is.na)) != ncol(.))
}

f5 <- function(dat) {
  dat %>% mutate(indx = row_number()) %>% gather(var, val, -indx) %>% group_by(indx) %>% filter(sum(is.na(val)) != n()) %>% spread(var, val) 
}

# f1 is too slow to be included!
microbenchmark(f2 = f2(dat), f3 = f3(dat), f4 = f4(dat), f5 = f5(dat))

L'utilisation de Reduce et lapply semble être la plus rapide:

> microbenchmark(f2 = f2(dat), f3 = f3(dat), f4 = f4(dat), f5 = f5(dat))
Unit: microseconds
 expr        min          lq       mean      median         uq        max neval
   f2    909.495    986.4680   2948.913   1154.4510   1434.725 131159.384   100
   f3    946.321   1036.2745   1908.857   1221.1615   1805.405   7604.069   100
   f4    706.647    809.2785   1318.694    960.0555   1089.099  13819.295   100
   f5 640392.269 664101.2895 692349.519 679580.6435 709054.821 901386.187   100

Utilisation d'un plus grand ensemble de données 107,880 x 40:

dat <- diamonds
# Let every third row be NA
dat[seq(1, nrow(diamonds), 3), ]  <- NA
# Add some extra NA to first column so na.omit() wouldn't work
dat[seq(2, nrow(diamonds), 3), 1] <- NA
# Increase size
dat <- dat %>% 
  bind_rows(., .) %>%
  bind_cols(., .) %>%
  bind_cols(., .)
# Make names unique
names(dat) <- 1:ncol(dat)
microbenchmark(f2 = f2(dat), f3 = f3(dat), f4 = f4(dat))

f5 est trop lent, il est donc également exclu. f4 semble faire relativement mieux qu'avant.

> microbenchmark(f2 = f2(dat), f3 = f3(dat), f4 = f4(dat))
Unit: milliseconds
 expr      min       lq      mean    median       uq      max neval
   f2 34.60212 42.09918 114.65140 143.56056 148.8913 181.4218   100
   f3 35.50890 44.94387 119.73744 144.75561 148.8678 254.5315   100
   f4 27.68628 31.80557  73.63191  35.36144 137.2445 152.4686   100
9
hejseb

Voici une autre solution qui utilise purrr::map_lgl() et tidyr::nest():

library(tidyverse)

dat <- tibble(a = c(1, 2, NA), b = c(1, NA, NA), c = c(2, NA, NA))

any_not_na <- function(x) {
  !all(map_lgl(x, is.na))
}


dat_cleaned <- dat %>%
  rownames_to_column("ID") %>%
  group_by(ID) %>%
  nest() %>%
  filter(map_lgl(data, any_not_na)) %>%
  unnest() %>%
  select(-ID)
## Warning: package 'bindrcpp' was built under R version 3.4.2

dat_cleaned
## # A tibble: 2 x 3
##       a     b     c
##   <dbl> <dbl> <dbl>
## 1    1.    1.    2.
## 2    2.   NA    NA

Je doute que cette approche puisse rivaliser avec les repères de la réponse de @ hejseb, mais je pense qu'elle fait un très bon travail pour montrer comment le nest %>% map %>% unnest le modèle fonctionne et les utilisateurs peuvent le parcourir ligne par ligne pour comprendre ce qui se passe.

2
Tiernan