当前位置：首页技术文章正文

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

01-05 技术文章 164

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亿个观察值。

提前谢谢你！

Error in as.Date.numeric(c(27, 32:34, 36:41)) : ‘origin’ must be supplied
@NelsonGon 尝试：as.Date.numeric(c(27, 32:34, 36:41),origin=”1970-01-01″)
感谢@Soren。

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

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

谢谢！那是天才，也很难消化。你能告诉我如何解释 +(x > shift(x) + 0.5)[-1] 吗？我不明白 +( …) 和 [-1] 的用途。
别客气！当然，会添加一个简短的描述。
我真的很感激。我以为 by 只能用于控制特定的组变量，但不知道在嵌套条件下使用它是如此灵活。 e？？？
确实 – 它非常灵活

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

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 字段。您也可以在单个过滤器语句中执行此操作

它没有给出预期的结果。
为什么不应该删除第 7 行？
我认为 OP 正在考虑删除一行然后将下一个后续行与最后一个未删除行进行比较的解决方案。
这不起作用，因为第 7 行将被删除，但我需要保留它。我尝试从第 1 个到第 N 个差异进行计算，并生成标签以标记它们是否有资格删除，但对于庞大的数据集(大约 8GB 大小)来说非常繁琐且效率低下。
你说 between any two rows nearby ，所以它应该只用于 /- 2 行吗？
对不起，我没有拿起准确的词。不只是 /- 2，它可以大于 2 但小于变量 t 的长度。

来源：https://www.codenong.com/55061869/

微信公众号

手机浏览(小程序)

Warning: get_headers(): SSL operation failed with code 1. OpenSSL Error messages: error:14090086:SSL routines:ssl3_get_server_certificate:certificate verify failed in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

Warning: get_headers(): Failed to enable crypto in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

Warning: get_headers(https://static.shanhubei.com/qrcode/qrcode_viewid_9816.jpg): failed to open stream: operation failed in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

0

分享到：