按条件筛选数据表，但每N行至少保留一行

Question

假设我有这个琐碎的数据表：

library(data.table)

dt <- data.table(
  day = 1:10,
  a = c(0, 1, 10, 2, 2.5, 2.3, 2.7, 2.9, 5, 8)
)

我想根据 a 上的某些条件对其进行过滤。在这种情况下，就是当 a 变化超过 3 时的时刻。这很简单：

dt[abs(a - shift(a)) >= 3]

然而，我不想在很长时间内失去信息。因此，如果上述条件没有匹配，我需要确保没有大于3天的“被过滤掉”的时间段。

在上述情况下，基于 a 的条件被满足：

dt[, abs(a - shift(a)) >= 3]
# [1]    NA FALSE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE  TRUE
                              -----------------------------

注意到末尾有一长串的FALSE。我能想到的最好解释是：

dt[, abs(a - shift(a)) >= 3 | .I %% 3 == 0]
# [1]    NA FALSE  TRUE  TRUE FALSE  TRUE FALSE FALSE  TRUE  TRUE
                                     ----              ----

即确保每三行中有一行被接受，但它不能放置最佳或最少的额外行。

最佳结果是一个过滤器，在一行“FALSE”的中间位置（或者需要多少个位置）用单个“TRUE”打破该行。

# [1]    NA FALSE  TRUE  TRUE FALSE FALSE TRUE FALSE FALSE  TRUE
                                          ----

- Wasabi

---

要同时做到强健（捕捉所有情况）和高效（仅保存必要的行），你需要采用迭代方法。（1）根据基本条件进行筛选；（2）对于每个“过长”的间隔，基于前后行确定你的间隔并将其包含在逻辑中。这不是非常优美，但我不知道是否有一个简单的“运行逻辑”可以涵盖所有的条件。 - r2evans

@r2evans 我认为不需要“最优”间隔。间隔是预定义的：“确保每三行（第n行）被接受”。 - Shree

真的，我并没有假设所有行都总是相隔一天。(在数据处理方面，我有点过于谨慎和防御性，因为1行的滞后并不总是意味着1天的滞后，也许是同一天或相差一周。)也许我把它复杂化了。(如果OP语言改为“没有超过3行的被过滤拉伸”，那么就不会有歧义了。) - r2evans

同样地，“每3天”这个条件是从最近的“满足条件”的行开始计算的，而不一定是基于“行号模3”，因为这可能会引入比严格必要的更多的行。（因此我在“健壮而高效”上发表了评论，这需要仔细平衡。） - r2evans

@r2evans 没错。我的解决方案是添加 .I %%3 == 0 条件，它可以确保不存在超过3个的连续行。然而，在选择需要打破连续行的行时，它并不是非常高效，这正是我提出这个问题的原因：看看是否有更好的解决方案。 - Wasabi

你的逻辑是“不超过3行”（或者day除了“1”以外，永远不会有其他不同的值），还是真的是“3天”，而且day可以变化不止1？ - r2evans

Answer 1

也许有人可以在 data.table 中复制这个任务，但以下是您可能正在寻找的逻辑。我将 test、run_length 和 result 分别分离出来，只是为了清晰明了，但如果需要，这个逻辑可以合并或包装在一个函数中。

此代码保留了所有行，其中：

1. test 为 TRUE

   或者

2. 在每个 TRUE 和 FALSE 的连续中的每第 N 行。

这样，第一个条件保留了所有的 TRUE，第二个条件捕获了每个连续的 N 元素，从而也包括了一些 FALSE。

library(dplyr)

N <- 3

dt %>% 
  mutate(
    test = abs(a - lag(a)) >= N, # flag change(a) >= N
    run_length = sequence(rle(test)$lengths), # seq along streaks of TRUE and FALSE
    result = test | run_length %% N == 0 
  ) # %>% 
  # filter(result) # uncomment this to get final dt

   day    a  test run_length result
1    1  0.0    NA          1     NA
2    2  1.0 FALSE          1  FALSE
3    3 10.0  TRUE          1   TRUE
4    4  2.0  TRUE          2   TRUE
5    5  2.5 FALSE          1  FALSE
6    6  2.3 FALSE          2  FALSE
7    7  2.7 FALSE          3   TRUE
8    8  2.9 FALSE          4  FALSE
9    9  5.0 FALSE          5  FALSE
10  10  8.0  TRUE          1   TRUE

在 `data.table` 中（我猜测），-

dt[, (test <- abs(a - shift(a)) >= N) | sequence(rle(test)$lengths) %% N == 0]

[1] NA FALSE  TRUE  TRUE FALSE FALSE  TRUE FALSE FALSE  TRUE

- Shree

---

那个 data.table 版本运行得非常好。你能稍微详细解释一下吗？我有点难以理解它（主要是 with 语句，因为我的理解是我可以将其重写为 ... | sequence(lengths(rle(test))) %% 3 == 0，但实际上这会得到不同的结果）。我也从未见过在 j 中使用 <- 来创建其他计算中可用的临时列。 - Wasabi

点赞rle解决方案，这就是我所思考的概念，但我没有理解它。 - r2evans

@Wasabi 我编辑了答案，删除了 with()。至于 (test <- ...)，我认为它会在全局环境中创建名为 test 的对象，但显然它并没有，但代码仍然可以正常工作！我无法解释为什么，因为我从来没有真正使用过 data.table。无论如何，我在我的 dplyr 代码中添加了更多的解释和注释，以提高逻辑的清晰度。请告诉我。 - Shree

Answer 2

如果您真的意思是没有“被过滤出”大于3 行的区间，那么这里有一个尝试。您的abs（a-shift（a））使第一个条件成为NA，这会影响到cumsum步骤，因此我们可以用以下之一来替换它:

c(FALSE, abs(diff(a)) >= 3)
.I > 1 & abs(a - shift(a)) >= 3
abs(a - shift(a, fill = a[1])) >= 3

这将确保第一行不被忽略。对于此演示，我将使用第三行，因为它与您使用的shift相一致，您可以根据维护需求自行选择。

挑战就在于：给定一个向量，确定元素，使所选元素之间的间隔永远不超过某个定义值（在本例中为3）。定义no_further为“不再than前面的' true '超过这么多步”(也许我需要修改措辞)。

no_further(4:10, than = 3)      # expect: '7'
# [1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE

v <- c(4, 6, 8, 9, 10)
### 4 to 8 is too far, need '6' to be included
### 6 to 8 is good
### 6 to 9 is good, but since 6 to 10 is too far, need '9' to be included
no_further(v, than = 3) # expect: '6', '9'
# [1] FALSE  TRUE FALSE  TRUE FALSE

no_further <- function(x, than) {
  i <- 1
  out <- logical(length(x))
  while (i < length(x)) {
    d <- x - x[i]
    if (!is.na(toobig <- which(d > than)[1])) {
      out[ toobig-1 ] <- TRUE
      i <- toobig-1
    } else break
  }
  out
}

我们可以在数据的每个分组中使用此函数（一个分组定义为从另一个条件开始）：

library(magrittr) # solely for demo with %>% pipes, not needed for the function
dt %>%
  .[, keep := abs(a - shift(a, fill = a[1])) >= 3 ] %>%
  .[, grp1 := cumsum(keep) ] %>%
  .[, keep2 := keep | no_further(day, than = 3), by = "grp1" ]
#     day    a  keep grp1 keep2
#  1:   1  0.0 FALSE    0 FALSE
#  2:   2  1.0 FALSE    0 FALSE
#  3:   3 10.0  TRUE    1  TRUE
#  4:   4  2.0  TRUE    2  TRUE
#  5:   5  2.5 FALSE    2 FALSE
#  6:   6  2.3 FALSE    2 FALSE
#  7:   7  2.7 FALSE    2  TRUE
#  8:   8  2.9 FALSE    2 FALSE
#  9:   9  5.0 FALSE    2 FALSE
# 10:  10  8.0  TRUE    3  TRUE

我只是使用magrittr使得代码可读性更好，但并没有严格的必要性。

- r2evans

---

请忽略我之前的评论（如果您看到了）。我想我终于明白你想做什么了。我觉得你的意思是在答案开头写 "filtered-out" stretch greater than 3 days，对吗？ - Shree

Answer 3

好的，这可能是最不优雅的解决方案，但使用您的示例：

temp <- dt[,abs(a - shift(a)) >=3]

for(i in 3:length(temp)) {
  if(!(temp[i]|temp[i-1]|temp[i-2])) {
    temp[[i]] <- T
  }
}

- SirTain

Answer 4

这是我的data.table方法

（编辑：在阅读其他答案后，它遵循了@shree的data.table方法的逻辑）。

#create a column which is TRUE when a changes >= 3
dt[, change_3 := (abs(a - shift(a)) >= 3)]
#create groups based on value the change_3 column
dt[, no_change_gr := rleidv( dt$change_3 ) ]
#create rownumbers within each group of no_change_gr
dt[, no_change_rowid := rowid( no_change_id )]
#mark rownumbers where %%3 == 0 with TRUE
dt[no_change_rowid %% 3 == 0, false_3 := TRUE]
#filter out rows where either change_3 or false_3 is TRUE
dt[ change_3 == TRUE | false_3 == TRUE, .(day,a)][]

#    day    a
# 1:   3 10.0
# 2:   4  2.0
# 3:   7  2.7
# 4:  10  8.0

我没有合并行，所以您可以查看每个步骤的结果。 如果输出符合预期，您可以将操作合并为更短的代码（行数更少）

- Wimpel