计算一个序列以包含 NA 值答案

【问题标题】：Count a sequence to include NA values计算一个序列以包含 NA 值
【发布时间】：2017-04-06 20:21:15
【问题描述】：

这是一个类似于更大数据集的示例数据框：

Day <- c(1, 2, NA, 3, 4, NA, NA, NA, NA, NA, 1, 2, 3, NA, NA, NA, NA, 1, 2, NA, NA, 3, 4, 5)
y   <- rpois(length(Day), 2)
z   <- seq(1:length(Day)) + 500
df  <- data.frame(z, Day, y)

如果“天”列中有 4 个或更多缺失值 (NA) 的序列，则该序列表示研究中的群组之间存在差距。如果序列中的 NA 少于 4 个，则缺失值仍被视为队列的一部分（例如，第 3 行是队列 1 的一部分，但第 8 行不是）。在示例数据框中，有 3 个群组（群组 1：第 1-5 行，群组 2：第 11-13 行，群组 3：第 18-24 行）。我想添加一列列出队列编号和另一列列出队列研究日。这是我使用的代码：

require(dplyr)
CheckNA        <- rle(is.na(df$Day))
CheckNA$values <- CheckNA$lengths >= 4 & CheckNA$values == 1
ListNA         <- rep(CheckNA$values, CheckNA$lengths)
df$Co          <- rep(c(1, NA, 2, NA, 3), rle(ListNA)$lengths) %>% as.factor()

df <- df %>% 
  group_by (Co) %>% 
  mutate(CoDay = seq(Co)) %>% 
  as.data.frame()

df$CoDay <- ifelse(is.na(df$Co), NA, df$CoDay)

有没有更有效的方法来完成这项任务？我专门寻找代码以避免列出队列编号，因为我的实际数据集将有超过 10 个队列。我目前只列出应该重复的序列：c(1, NA, 2, NA, 3)。

【问题讨论】：

这已在代码审查中交叉发布：codereview.stackexchange.com/questions/160059/…
我已将其从代码审查中删除。

标签： r sequence

【解决方案1】：

我会在这里做出改变

CheckNA        <- rle(is.na(df$Day))
CheckNA$values <- CheckNA$lengths >= 4 & CheckNA$values == 1
CheckNA$values <- ifelse(!CheckNA$values, cumsum(CheckNA$values)+1, NA)
df$Co <- inverse.rle(CheckNA)

我保持前两行相同，然后我使用cumsum() 在每次中断时分配新的 ID。这意味着您不必对任何值进行硬编码。使用新值，您可以像使用 rep() 一样使用 inverse.rle 将新 ID 扩展到每一行。

如果你把它变成一个函数，你可以清理dplyr位

id_NA_break <- function(x) {
  CheckNA        <- rle(is.na(x))
  CheckNA$values <- CheckNA$lengths >= 4 & CheckNA$values == 1
  CheckNA$values <- ifelse(!CheckNA$values, cumsum(CheckNA$values)+1, NA)
  inverse.rle(CheckNA)  
}

df  <- data.frame(z, Day, y)
df %>% 
  mutate(Co=id_NA_break(Day)) %>%
  group_by(Co) %>% 
  mutate(CoDay = ifelse(is.na(Co), NA, seq(Co)))

【讨论】：

【解决方案2】：

这是一个 data.table 解决方案。我不确定这两个函数将如何比较。我们必须对它们进行基准测试。通常 data.table 更快，但我最终在这里使用了很多步骤。

library(data.table)
Day <- c(1, 2, NA, 3, 4, NA, NA, NA, NA, NA, 1, 2, 3, NA, NA, NA, NA, 1, 2, NA, NA, 3, 4, 5)
y   <- rpois(length(Day), 2)
z   <- seq(1:length(Day)) + 500
df  <- data.frame(z, Day, y)

setDT(df)

df[ , "isNA" := ifelse(is.na(Day), 1, 0)]
df[ , "numNA" := rep(rle(isNA)$length*rle(isNA)$value, rle(isNA)$length)]
df[ , "Gap" := ifelse(numNA < 4, 0, 1)]
df[ , "Cohort" := cumsum(Gap)]

df[Gap == 1, "Cohort" := NA]
df[Gap == 0, "Cohort" := as.double(rleid(Cohort))]

> df
      z Day y isNA numNA Gap Cohort
 1: 501   1 1    0     0   0      1
 2: 502   2 2    0     0   0      1
 3: 503  NA 2    1     1   0      1
 4: 504   3 1    0     0   0      1
 5: 505   4 2    0     0   0      1
 6: 506  NA 2    1     5   1     NA
 7: 507  NA 1    1     5   1     NA
 8: 508  NA 0    1     5   1     NA
 9: 509  NA 4    1     5   1     NA
10: 510  NA 2    1     5   1     NA
11: 511   1 3    0     0   0      2
12: 512   2 3    0     0   0      2
13: 513   3 2    0     0   0      2
14: 514  NA 3    1     4   1     NA
15: 515  NA 1    1     4   1     NA
16: 516  NA 3    1     4   1     NA
17: 517  NA 2    1     4   1     NA
18: 518   1 4    0     0   0      3
19: 519   2 4    0     0   0      3
20: 520  NA 1    1     2   0      3
21: 521  NA 1    1     2   0      3
22: 522   3 3    0     0   0      3
23: 523   4 0    0     0   0      3
24: 524   5 3    0     0   0      3
      z Day y isNA numNA Gap Cohort

清理多余的列

df[ , c("isNA", "numNA", "Gap") := NULL]

编辑 MrFlick 的速度更快。我通过微基准测试了它们。

> microbenchmark(data_table_way(df))
Unit: milliseconds
               expr      min       lq     mean   median       uq      max neval
 data_table_way(df) 2.515004 2.678493 2.879678 2.770054 2.923348 4.917869   100

> microbenchmark(dplyr_way())
Unit: milliseconds
        expr      min       lq     mean   median       uq      max neval
 dplyr_way() 1.564279 1.703792 1.814998 1.765713 1.824615 2.773641   100

【讨论】：