关于 r：如何删除行间差异小于特定值的观察值


How to drop observations with inter-row difference being less than a specific value

我有一个 data.table，它由几个组(更具体的分层面板/经度数据集)组成，组中的一个单元格看起来像这样

1
2
3
4
5
6
7
8
9
10
11
12
13
14
z <- data.table(x = c(10, 10.5, 11.1, 14, 14.2, 14.4, 14.6, 17, 17.4, 30),
            t = as.Date(c(27, 32:34, 36:41)))
# that is:
#        x          t
#  1: 10.0 1970-01-28
#  2: 10.5 1970-02-02
#  3: 11.1 1970-02-03
#  4: 14.0 1970-02-04
#  5: 14.2 1970-02-06 # to be removed since 14.2-14.0 = 0.2 <0.5
#  6: 14.4 1970-02-07 # to be removed since 14.4-14.2 = 0.2 <0.5 and 14.4-14.0 = 0.4 <0.5
#  7: 14.6 1970-02-08 # shall NOT be removed because 14.6-14.0 = 0.6 > 0.5
#  8: 17.0 1970-02-09
#  9: 17.4 1970-02-10 # to be removed
# 10: 30.0 1970-02-11

为简单起见，这些组被排除在外，因此假设数据中只有两个变量(列)：

我需要删除附近任意两行之间的行间差异小于 0.5 的观察结果，所以我需要这样

1
2
3
4
5
6
7
8
#        x          t
#  1: 10.0 1970-01-31
#  2: 10.5 1970-02-02
#  3: 11.1 1970-02-03
#  4: 14.0 1970-02-04
#  7: 14.6 1970-02-08
#  8: 17.0 1970-02-09
# 10: 30.0 1970-02-11

最终满足neighbor中任意两个值在变量t的阶数上相差不小于0.5。

这样的data.table是否可能，但要大得多，有几个组和近1亿个观察值。

提前谢谢你！

相关讨论

如果我理解正确，你可以这样做：

1
2
3
4
5
6
7
library(data.table)

z <- z[, filt := min(x), by = cumsum(c(1, +(x >= shift(x) + 0.5)[-1]))][
  , filt := ifelse(x == filt,
                   shift(x, fill = x[1]),
                   filt)][
                     x - filt >= 0.5 | x == filt, ][, filt := NULL]

解释：

  • 首先我们计算每个组的 x 的最小值；
  • 组由 cumsum(c(1, +(x >= shift(x) + 0.5)[-1])) 创建。其中，我们检查每一行是否 x >= shift(x) + 0.5(x 与前一行之间的差异大于或等于 0.5)。这计算为 TRUE 或 FALSE 我们用 + 符号将其转换为 1 和 0；因为第一行总是 NA (因为没有前一行)，我们在表达式后用 [-1] 删除它。由于这意味着向量中的第一个值将丢失，我们构造另一个以 1 开头的值，然后是我们之前计算的值。之后我们应用 cumsum - 后者在每次有新行大于或等于前一个 0.5 时分配一个值；如果中间没有这样的行，它继续分配最后一个数字(因为我们已经插入 1 作为向量的开头，它将从 1 开始，每次遇到满足条件的行时增加 1不排除)；
  • 每个先前创建的组将有只有 1 行的行；在这种情况下，我们需要交叉检查与前一行的差异。在所有其他情况下，我们交叉检查与组的第一行的差异(即根据标准不应删除的最后一行，因为它大于前一个 0.5)；
  • 之后，我们只删除那些不满足条件的行加上我们保留等于自身的行(将始终是第一个)；我们在最后删除过滤变量。

输出：

1
2
3
4
5
6
7
8
      x          t
1: 10.0 1970-01-28
2: 10.5 1970-02-02
3: 11.1 1970-02-03
4: 14.0 1970-02-04
5: 14.6 1970-02-08
6: 17.0 1970-02-09
7: 30.0 1970-02-11
相关讨论

由于间隙取决于行的顺序删除，因此以下解决方案使用交互方法来识别并重新计算删除行后的后续间隙。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
z <- data.table(x = c(10, 10.5, 11.1, 14, 14.2, 14.4, 14.6, 17, 17.4, 30),
                t = as.Date(c(27, 32:34, 36:41)))
setkeyv(z,"t")

find_gaps <- function(dt) {
  dt[, last_x := shift(.SD, n=1, fill=NA, type="lag"), .SDcols="x"]
  gaps <- dt[,abs(x-last_x) < 0.5,]
  gap <- which(gaps==TRUE)[1]
  #print(paste0("Removing row:",gap))
  return (gap)
}

while(!is.na(gap<-find_gaps(z))) { z <- z[-gap] }

z

结果：

1
2
3
4
5
6
7
8
9
10
11
12
[1]"removing row: 5"
[1]"removing row: 5"
[1]"removing row: 7"
> z
      x          t last_x   gap
1: 10.0 1970-01-28     NA FALSE
2: 10.5 1970-02-02   10.0 FALSE
3: 11.1 1970-02-03   10.5 FALSE
4: 14.0 1970-02-04   11.1 FALSE
5: 14.6 1970-02-08   14.0 FALSE
6: 17.0 1970-02-09   14.6 FALSE
7: 30.0 1970-02-11   17.0 FALSE

备用

注意 8gb 文件并着眼于效率：提出一个好的旧 for loop() 作为最有效的

1
2
3
4
5
6
7
8
9
10
11
z1 <- data.table(x = c(10, 10.5, 11.1, 14, 14.2, 14.4, 14.6, 17, 17.4, 30), t = as.Date(c(27, 32:34, 36:41))) ; setkeyv(z1,"t")
x <- z1$x
last_x <- x[1]
gaps <- c()

for (i in 2:length(x))
{
  if (abs(x[i]-last_x) < 0.5) gaps <- c(gaps,i)
  else last_x <- x[i]
}
z1 <- z1[-(gaps)]

基准测试

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
microbenchmark::microbenchmark(times=100,
  forway={
    z1 <- data.table(x = c(10, 10.5, 11.1, 14, 14.2, 14.4, 14.6, 17, 17.4, 30), t = as.Date(c(27, 32:34, 36:41))) ; setkeyv(z1,"t")
    x <- z1$x; last_x <- x[1];  gaps <- c()

    for (i in 2:length(x)) { if (abs(x[i]-last_x) < 0.5) { gaps <- c(gaps,i); } else { last_x <- x[i]; } }
    z1 <- z1[-(gaps)]
  },
  datatableway={
    z2 <- data.table(x = c(10, 10.5, 11.1, 14, 14.2, 14.4, 14.6, 17, 17.4, 30), t = as.Date(c(27, 32:34, 36:41))) ; setkeyv(z2,"t")

    z2 <- z2[, filt := min(x), by = cumsum(c(1, +(x >= shift(x) + 0.5)[-1]))][, filt := ifelse(x == filt, shift(x, fill = x[1]), filt)][x - filt >= 0.5 | x == filt, ][, filt := NULL]
  },
  whileway={
    z3 <- data.table(x = c(10, 10.5, 11.1, 14, 14.2, 14.4, 14.6, 17, 17.4, 30), t = as.Date(c(27, 32:34, 36:41))) ; setkeyv(z3,"t")

    find_gaps <- function(dt) {
      dt[, last_x := shift(.SD, n=1, fill=NA, type="lag"), .SDcols="x"]
      gaps <- dt[,abs(x-last_x) < 0.5,]
      which(gaps==TRUE)[1]
    }
    while(!is.na(gap<-find_gaps(z3))) { z3 <- z3[-gap] }
  }
)

(z1==z2) & (z2==z3[,.(x,t)])

结果：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Unit: milliseconds
         expr       min        lq      mean    median        uq      max neval
       forway  2.741609  3.607341  4.067566  4.069382  4.556219  5.61997   100
 datatableway  7.552005  8.915333  9.839475  9.606205 10.762764 15.46430   100
     whileway 13.903507 19.059612 20.692397 20.577014 22.243933 27.44271   100
>
> (z1==z2) & (z2==z3[,.(x,t)])
        x    t
[1,] TRUE TRUE
[2,] TRUE TRUE
[3,] TRUE TRUE
[4,] TRUE TRUE
[5,] TRUE TRUE
[6,] TRUE TRUE
[7,] TRUE TRUE

你可以使用 dplyr::mutate 和 filter:

1
2
3
4
z %>%
  mutate(diff = lead(x, 1) - x) %>%
  filter(diff >= 0.5 | is.na(diff)) %>%
  select(-diff)

为了便于理解，我保留了 diff 字段。您也可以在单个过滤器语句中执行此操作

相关讨论