web-dev-qa-db-ja.com

dplyrを使用して、すべての変数がNAである行を削除します

一見単純なタスクにいくつかの問題があります：all変数がNAであるすべての行をdplyrを使用して削除する。私はそれがベースRを使用して行うことができることを知っています（ すべてのデータがNAであるR行列の行を削除する および 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)
_

しかし、それは仕事を終わらせますが、それはあまり素敵ではありません。他のアイデア？

rdplyrtidyverse
21
hejseb

Dplyr 0.7.0が新しくなったため、スコープフィルタリング動詞が存在します。 filter_anyを使用すると、欠落していない列が少なくとも1つある行を簡単にフィルタリングできます。

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

@hejsebベンチマークアルゴリズムを使用すると、このソリューションはf4と同じくらい効率的であるように見えます。

25
MarkusN

ベンチマーク

@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
9
hejseb

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パターンが機能し、ユーザーは行ごとに実行して、何が起こっているのかを把握できます。

2
Tiernan