同时删除数据框的第一行和最后一行,直到到达没有 NA 的行

Simultaneously remove the first and last rows of a data frame until reaching a row that does not have an NA

我有一个包含 NA 值的数据框,我想删除一些具有 NA 的行(即,不完整的案例)。但是,我只想删除数据框开头和结尾的行。因此,我想保留任何具有 NA 且不在数据框的第一行或最后一行中的行。在不使用行索引的情况下使用 NAs 同时删除这些行的最有效方法是什么?这与我的 , but I also want to remove the first rows at the same time. There are other posts that also focus on 有关,但不是两者都有关。

数据

df <- structure(list(var1 = 1:15, 
                     var2 = c(3, NA, 3, NA, 2, NA, 3, 4, 2, NA, 4, 2, 45, 2, 1), 
                     var3 = c(6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, NA, NA, NA, NA), 
                     var4 = c(NA, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, NA)), 
                class = "data.frame", row.names = c(NA, -15L))

预期输出

所以,在这个例子中,我删除了第 1 到 2 行和第 12 到 15 行,因为它们有 NA 而第 3 行和第 11 行没有 NA

  var1 var2 var3 var4
1    3    3    8    8
2    4   NA    9    9
3    5    2   10   10
4    6   NA   11   11
5    7    3   12   12
6    8    4   13   13
7    9    2   14   14
8   10   NA   15   15
9   11    4   16   16

我知道我可以在过滤器中使用 2 个语句来删除顶部和底部的行(如下所示)。但我想知道是否有更有效的方法来处理非常大的数据集(对任何方法 tidyverse、base R、data.table 等开放)。

library(dplyr)

df %>% 
  filter(cumsum(complete.cases(.)) != 0 & 
           rev(cumsum(rev(complete.cases(.)))) != 0)

我愿意

na_count <- rowSums(is.na(df))
df <- df %>%
  slice(min(which(na_count==0)):max(which(na_count==0)))

输出

> df
  var1 var2 var3 var4
1    3    3    8    8
2    4   NA    9    9
3    5    2   10   10
4    6   NA   11   11
5    7    3   12   12
6    8    4   13   13
7    9    2   14   14
8   10   NA   15   15
9   11    4   16   16

基础 R

r <- rle(complete.cases(df))
str(r, vec.len = 9)
# List of 2
#  $ lengths: int [1:9] 2 1 1 1 1 3 1 1 4
#  $ values : logi [1:9] FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE
#  - attr(*, "class")= chr "rle"
r$values[ -c(1, length(r$values)) ] <- TRUE
str(r, vec.len = 9)
# List of 2
#  $ lengths: int [1:9] 2 1 1 1 1 3 1 1 4
#  $ values : logi [1:9] FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE
#  - attr(*, "class")= chr "rle"
df[inverse.rle(r),]
#    var1 var2 var3 var4
# 3     3    3    8    8
# 4     4   NA    9    9
# 5     5    2   10   10
# 6     6   NA   11   11
# 7     7    3   12   12
# 8     8    4   13   13
# 9     9    2   14   14
# 10   10   NA   15   15
# 11   11    4   16   16

dplyr

对于您的效率问题,您也可以将 rle 解决方案应用于 dplyr(这应该是微不足道的),但我看不出为什么要使用 complete.casescumany/rev 将是一个问题。您可以通过不计算 complete.cases(.) 两次 来改进您的尝试,将其存储在临时列中。

library(dplyr)
df %>%
  mutate(aux = complete.cases(cur_data())) %>%
  filter(cumany(aux) & rev(cumany(rev(aux))))
#   var1 var2 var3 var4   aux
# 1    3    3    8    8  TRUE
# 2    4   NA    9    9 FALSE
# 3    5    2   10   10  TRUE
# 4    6   NA   11   11 FALSE
# 5    7    3   12   12  TRUE
# 6    8    4   13   13  TRUE
# 7    9    2   14   14  TRUE
# 8   10   NA   15   15 FALSE
# 9   11    4   16   16  TRUE

data.table

(只是对 dplyr 版本的改编。)

library(data.table)
setDT(df)
df[, aux := complete.cases(.SD)
  ][ cumsum(aux) > 0 & rev(cumsum(rev(aux)) > 0), ]
#     var1  var2  var3  var4    aux
#    <int> <num> <int> <int> <lgcl>
# 1:     3     3     8     8   TRUE
# 2:     4    NA     9     9  FALSE
# 3:     5     2    10    10   TRUE
# 4:     6    NA    11    11  FALSE
# 5:     7     3    12    12   TRUE
# 6:     8     4    13    13   TRUE
# 7:     9     2    14    14   TRUE
# 8:    10    NA    15    15  FALSE
# 9:    11     4    16    16   TRUE

继续 rle 爱情盛宴:

(which(rle(rowSums(df_NA))$values != 'NA')[1]):dplyr::last(which(rle(rowSums(df_NA))$values != 'NA'))
[1]  3  4  5  6  7  8  9 10 11

或者,免除 dplyr

(which(rle(rowSums(df_NA))$values != 'NA')[1]):(which(rle(rowSums(df_NA))$values != 'NA'))[[(length(which(rle(rowSums(df_NA))$values != 'NA')))]]
[1]  3  4  5  6  7  8  9 10 11

另一种可能的解决方案(感谢@r2evans 建议complete.cases):

library(dplyr)

df %>% 
  mutate(aux = !complete.cases(.)) %>% 
  filter(!cumall(aux)) %>% 
  arrange(desc(var1)) %>% 
  filter(!cumall(aux)) %>%
  arrange(var1) %>% 
  select(-aux)

#>   var1 var2 var3 var4
#> 1    3    3    8    8
#> 2    4   NA    9    9
#> 3    5    2   10   10
#> 4    6   NA   11   11
#> 5    7    3   12   12
#> 6    8    4   13   13
#> 7    9    2   14   14
#> 8   10   NA   15   15
#> 9   11    4   16   16

基准

在这里,我创建了一个更大的数据集,其中包含 1,000,000 百万行 3 个变量,以确定哪种方法最快。 *注意:将 NA 值随机应用于前 100,000 行和后 100,000 行的 3 列需要几秒钟。本质上,对于这个例子,我们想要删除前 100,000 行和最后 100,000 行。

数据集

set.seed(203)
df <- data.frame(var1 = sample(x = 1:500, size = 1000000, replace = TRUE),
                 var2 = sample(x = 1:500, size = 1000000, replace = TRUE),
                 var3 = sample(x = 1:500, size = 1000000, replace = TRUE))
df[1:100000,] <- plyr::ddply(df[1:100000,], .(var1, var2, var3), function(x) {x[sample(x = 1:3, size = 1, replace = TRUE)] <- NA;x})
df[900000:1000000,] <- plyr::ddply(df[900000:1000000,], .(var1, var2, var3), function(x) {x[sample(x = 1:3, size = 1, replace = TRUE)] <- NA;x})
df[300000:400000,2] <- NA

输出

看起来@MerijnvanTilborg data.table 解决方案是最快的,其次是此示例数据集上的@r2evans data.table 版本。

代码

library(tidyverse)
library(data.table)

df1 <- df
dt1 <- as.data.table(df)
dt2 <- as.data.table(df)

bm <- microbenchmark::microbenchmark(baseR_r2evans = {r <- rle(complete.cases(df1)); 
r$values[ -c(1, length(r$values)) ] <- TRUE; df[inverse.rle(r),]},
dplyr_r2evans = {df %>%
    dplyr::mutate(aux = complete.cases(cur_data())) %>%
    dplyr::filter(cumany(aux) & rev(cumany(rev(aux))))},
datatable_r2evans = {dt1[, aux := complete.cases(.SD)
][ cumsum(aux) > 0 & rev(cumsum(rev(aux)) > 0), ]},
valkyr = {na_count <- rowSums(is.na(df)); df %>%
  dplyr::slice(min(which(na_count==0)):max(which(na_count==0)))},
PaulS = {df %>% 
    dplyr::mutate(aux = !complete.cases(.)) %>% 
    dplyr::filter(!cumall(aux)) %>% 
    dplyr::arrange(desc(var1)) %>% 
    dplyr::filter(!cumall(aux)) %>%
    dplyr::arrange(var1) %>% 
    dplyr::select(-aux)},
Chris = {df[(which(rle(rowSums(df))$values != 'NA')[1]):(which(rle(rowSums(df))$values != 'NA'))[[(length(which(rle(rowSums(df))$values != 'NA')))]],]},
AndrewGB = {df %>% 
    dplyr::filter(cumsum(complete.cases(.)) != 0 & 
                    rev(cumsum(rev(complete.cases(.)))) != 0)},
Merijn_baseR = {s <- which(complete.cases(df)); 
df[first(s):last(s), ]},
Merijn_datatable = {dt2[, aux := complete.cases(.SD)][first(which(aux)):last(which(aux))]},
times = 1000
)

我认为我们把它复杂化了一点,我认为最有效的只是简单的基础 R

直接拿走你所有的完整案例

s <- which(complete.cases(df))

我们当然不能对 s 进行子集化,因为我们也想保留所有“介于两者之间”的不完整索引,我们可以通过简单地从第一个索引到最后一个索引进行子集化来实现。

df[first(s):last(s), ]

晚会有点晚,但在单个表达式中以 R 为基数:

df[Reduce(
  function(x, y){
    seq(from = x, to = y)
  },
  range(
    which(
    complete.cases(df)
    )
  )
), ]