Удалите строки, где все переменные являются NA, используя dplyr

У меня есть некоторые проблемы с, казалось бы, простой задачей: удалить все строки, где все переменные NA с помощью dplyr. Я знаю, что это можно сделать с помощью базы R (удаление строк в матрице R, где все данные - NA и удаление пустых строк в файле данных в R), но мне интересно знать, существует ли простой способ сделать это с помощью dplyr,

Пример:

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

Вызов filter выше делает то, что я хочу, но это невозможно в ситуации, с которой я сталкиваюсь (поскольку существует большое количество переменных). Я думаю, что можно было бы сделать это, используя filter_ и сначала создав строку с (длинным) логическим оператором, но, похоже, должен быть более простой способ.

Другой способ - использовать rowwise() и do():

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

но это не выглядит слишком хорошо, хотя и выполняет свою работу. Другие идеи?

Ответ 1

Поскольку dplyr 0.7.0 содержит новые, ограниченные фиктивные глаголы. Используя filter_any, вы можете легко фильтровать строки по крайней мере с одним столбцом без пропусков:

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

Используя алгоритм бенчмаркинга @hejseb, кажется, что это решение столь же эффективно, как и f4.

Ответ 2

Бенчмаркинг

@DavidArenburg предложил ряд альтернатив. Здесь простой бенчмаркинг их.

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

Использование Reduce и lapply представляется самым быстрым:

> 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

Использование большего набора данных 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 слишком медленный, поэтому он также исключается. f4 похоже, относительно лучше, чем раньше.

> 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

Ответ 3

Здесь другое решение, использующее purrr::map_lgl() и 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

Я сомневаюсь, что этот подход сможет конкурировать с бенчмарками в ответе @hejseb, но я думаю, что он неплохо справляется с показом того, как работает шаблон nest %>% map %>% unnest и пользователи могут проходить через него -line выяснить, что происходит.