在 R 中使用 data.table 为多行组创建标识符的最快方法是什么?
What is the fastest way of creating an identificator for multi-row groups with data.table in R?
我有一个数据框,它标识一组具有 id 的值:
library(data.table)
dt <- data.table(
id = rep(c("a", "b", "c"), each = 2),
value1 = c(1, 1, 1, 2, 1, 1),
value2 = c(0, 3, 0, 3, 0, 3)
)
dt
#> id value1 value2
#> 1: a 1 0
#> 2: a 1 3
#> 3: b 1 0
#> 4: b 2 3
#> 5: c 1 0
#> 6: c 1 3
如您所见,ids a
和 c
标识同一组值。所以我想创建一个“模式 id”,它标识与 ids a
和 c
关联的值集(obs:一个 id 可能标识两行以上,我只是将它们限制为两行为了简单起见,在此处列行)。
我确实想出了一个使用嵌套 data.tables 和 match()
的解决方案:
dt <- dt[, .(data = list(.SD)), by = id]
unique_groups <- unique(dt$data)
dt[, pattern_id := match(data, unique_groups)]
dt[, data := NULL]
dt
#> id pattern_id
#> 1: a 1
#> 2: b 2
#> 3: c 1
它可以 解决问题,但速度不如我希望的那样快。 match()
关于列表效率的文档非常清楚:
Matching for lists is potentially very slow and best avoided except in simple cases.
如您所见,我的最终结果中不需要实际的模式数据,只需要 table 将 id 与模式 id 相关联。感觉把数据嵌套起来,用它来匹配,然后再丢弃,有点浪费,但不确定是否有更好的方法。我正在考虑将每个数据帧转换为字符串的方法,或者更好的是,完全避免嵌套的方法,但我想不出比现在更好的方法了。
我创建了一个更大的数据集来尝试和测试不同的解决方案:
set.seed(0)
size <- 1000000
dt <- data.table(
id = rep(1:(size / 2), each = 2),
value1 = sample(1:10, size, replace = TRUE),
value2 = sample(1:10, size, replace = TRUE)
)
重塑更宽的形状并使用 paste0()
怎么样?
library(dplyr)
library(tidyr)
dt <- dt %>% group_by(id) %>%
mutate(inst = row_number(id)) %>%
pivot_wider(values_from = c(value1, value2),
names_from = inst) %>%
mutate(pattern_id = paste0(value1_1, value1_2, value2_1, value2_2))
已更新(删除加入):
这个方法复制了您的方法(即它要求顺序和值都相同)
unique(
dt[, pattern:=.(paste0(c(value1,value2), collapse=",")), by=id][,.(id,pattern)]
)[,grp:=.GRP, by=pattern][,pattern:=NULL]
id grp
<char> <int>
1: a 1
2: b 2
3: c 1
先前的解决方案:
dt[dt[, .(paste0(sort(c(value1,value2)), collapse=",")), by=id] %>%
.[,pattern:=.GRP, by=V1] %>%
.[,V1:=NULL], on=.(id)]
输出:
id value1 value2 pattern
<char> <num> <num> <int>
1: a 1 0 1
2: a 1 3 1
3: b 1 0 2
4: b 2 3 2
5: c 1 0 1
6: c 1 3 1
使用 toString
,如 data.table
将列表用作 by
时的错误消息所建议:
Column or expression 1 of 'by' is type 'list' which is not currently supported.
As a workaround, consider converting the column to a supported type, e.g. by=sapply(list_col, toString)
dt <- dt[, .(data = list(.SD)), by = id]
dt[, pattern_id :=.GRP, by = sapply(data, toString)]
dt[,unlist(data,recursive=F),by=.(id,pattern_id)]
id pattern_id value1 value2
<char> <int> <num> <num>
1: a 1 1 0
2: a 1 1 3
3: b 2 1 0
4: b 2 2 3
5: c 1 1 0
6: c 1 1 3
但是,这比 match
慢。
假设每个 id 重复两次,“重塑”- 将 2x2 转换为 1x4 列。然后通过按除 id:
之外的所有列分组,使用 .GRP 获取组 ID
res <- dt[, c(.SD[ 1 ], .SD[ 2 ]), by = id]
setnames(res, make.unique(colnames(res)))
res[, pattern_id := .GRP, by = res[, -1] ][, .(id, pattern_id)]
# id pattern_id
# 1: 1 1
# 2: 2 2
# 3: 3 3
# 4: 4 4
# 5: 5 5
# ---
# 499996: 499996 1010
# 499997: 499997 3175
# 499998: 499998 3996
# 499999: 499999 3653
# 500000: 500000 4217
使用更大的数据集大约需要半秒。
编辑:使用dcast的另一个版本,但速度慢了8倍:
res <- dcast(dt, id ~ value1 + value2, length)
res[, pattern_id :=.GRP, by = res[, -1] ][, .(id, pattern_id)]
我们可以试试下面的代码
dt[
,
q := toString(unlist(.SD)), id
][
,
pattern_id := .GRP, q
][
,
q := NULL
][]
或
dt[
,
q := toString(unlist(.SD)),
id
][
,
pattern_id := as.integer(factor(match(q, q)))
][
,
q := NULL
][]
这给出了
id value1 value2 pattern_id
1: a 1 0 1
2: a 1 3 1
3: b 1 0 2
4: b 2 3 2
5: c 1 0 1
6: c 1 3 1
这里有一些不依赖于每个 id 的基准,这些 id 必须标识两行,我在下面发布结果。
library(data.table)
set.seed(0)
size <- 500000
dt <- data.table(
id = rep(1:(size / 2), each = 2),
value1 = sample(1:10, size, replace = TRUE),
value2 = sample(1:10, size, replace = TRUE)
)
my_solution <- function(x) {
x <- x[, .(data = list(.SD)), by = id]
unique_groups <- unique(x$data)
x[, pattern_id := match(data, unique_groups)]
x[, data := NULL]
x[]
}
langtang_solution <- function(x) {
x <- x[, .(data = paste0(value1, "|", value2, collapse = ";")), by = id]
x[, pattern_id := .GRP, by = data]
x[, data := NULL]
x[]
}
thomasiscoding_solution <- function(x) {
x <- x[, .(data = toString(unlist(.SD))), by = id]
x[, pattern_id := .GRP, by = data]
x[, data := NULL]
x[]
}
identical(my_solution(dt), langtang_solution(dt))
#> [1] TRUE
identical(my_solution(dt), thomasiscoding_solution(dt))
#> [1] TRUE
microbenchmark::microbenchmark(
my_solution(dt),
langtang_solution(dt),
thomasiscoding_solution(dt),
times = 50L
)
#> Unit: seconds
#> expr min lq mean median uq
#> my_solution(dt) 3.174106 3.566495 3.818829 3.793850 4.015176
#> langtang_solution(dt) 1.369860 1.467013 1.596558 1.529327 1.649607
#> thomasiscoding_solution(dt) 3.014511 3.154224 3.280713 3.256732 3.370015
#> max neval
#> 4.525275 50
#> 2.279064 50
#> 3.681657 50
这非常丰富。我不知道 .GRP
,在我的测试中,它的表现与 match()
非常相似,尽管(非常小)好一点。最好的答案似乎是使用 paste()
将组转换为字符串,然后根据该字符串找到组。
我有一个数据框,它标识一组具有 id 的值:
library(data.table)
dt <- data.table(
id = rep(c("a", "b", "c"), each = 2),
value1 = c(1, 1, 1, 2, 1, 1),
value2 = c(0, 3, 0, 3, 0, 3)
)
dt
#> id value1 value2
#> 1: a 1 0
#> 2: a 1 3
#> 3: b 1 0
#> 4: b 2 3
#> 5: c 1 0
#> 6: c 1 3
如您所见,ids a
和 c
标识同一组值。所以我想创建一个“模式 id”,它标识与 ids a
和 c
关联的值集(obs:一个 id 可能标识两行以上,我只是将它们限制为两行为了简单起见,在此处列行)。
我确实想出了一个使用嵌套 data.tables 和 match()
的解决方案:
dt <- dt[, .(data = list(.SD)), by = id]
unique_groups <- unique(dt$data)
dt[, pattern_id := match(data, unique_groups)]
dt[, data := NULL]
dt
#> id pattern_id
#> 1: a 1
#> 2: b 2
#> 3: c 1
它可以 解决问题,但速度不如我希望的那样快。 match()
关于列表效率的文档非常清楚:
Matching for lists is potentially very slow and best avoided except in simple cases.
如您所见,我的最终结果中不需要实际的模式数据,只需要 table 将 id 与模式 id 相关联。感觉把数据嵌套起来,用它来匹配,然后再丢弃,有点浪费,但不确定是否有更好的方法。我正在考虑将每个数据帧转换为字符串的方法,或者更好的是,完全避免嵌套的方法,但我想不出比现在更好的方法了。
我创建了一个更大的数据集来尝试和测试不同的解决方案:
set.seed(0)
size <- 1000000
dt <- data.table(
id = rep(1:(size / 2), each = 2),
value1 = sample(1:10, size, replace = TRUE),
value2 = sample(1:10, size, replace = TRUE)
)
重塑更宽的形状并使用 paste0()
怎么样?
library(dplyr)
library(tidyr)
dt <- dt %>% group_by(id) %>%
mutate(inst = row_number(id)) %>%
pivot_wider(values_from = c(value1, value2),
names_from = inst) %>%
mutate(pattern_id = paste0(value1_1, value1_2, value2_1, value2_2))
已更新(删除加入):
这个方法复制了您的方法(即它要求顺序和值都相同)
unique(
dt[, pattern:=.(paste0(c(value1,value2), collapse=",")), by=id][,.(id,pattern)]
)[,grp:=.GRP, by=pattern][,pattern:=NULL]
id grp
<char> <int>
1: a 1
2: b 2
3: c 1
先前的解决方案:
dt[dt[, .(paste0(sort(c(value1,value2)), collapse=",")), by=id] %>%
.[,pattern:=.GRP, by=V1] %>%
.[,V1:=NULL], on=.(id)]
输出:
id value1 value2 pattern
<char> <num> <num> <int>
1: a 1 0 1
2: a 1 3 1
3: b 1 0 2
4: b 2 3 2
5: c 1 0 1
6: c 1 3 1
使用 toString
,如 data.table
将列表用作 by
时的错误消息所建议:
Column or expression 1 of 'by' is type 'list' which is not currently supported.
As a workaround, consider converting the column to a supported type, e.g. by=sapply(list_col, toString)
dt <- dt[, .(data = list(.SD)), by = id]
dt[, pattern_id :=.GRP, by = sapply(data, toString)]
dt[,unlist(data,recursive=F),by=.(id,pattern_id)]
id pattern_id value1 value2
<char> <int> <num> <num>
1: a 1 1 0
2: a 1 1 3
3: b 2 1 0
4: b 2 2 3
5: c 1 1 0
6: c 1 1 3
但是,这比 match
慢。
假设每个 id 重复两次,“重塑”- 将 2x2 转换为 1x4 列。然后通过按除 id:
之外的所有列分组,使用 .GRP 获取组 IDres <- dt[, c(.SD[ 1 ], .SD[ 2 ]), by = id]
setnames(res, make.unique(colnames(res)))
res[, pattern_id := .GRP, by = res[, -1] ][, .(id, pattern_id)]
# id pattern_id
# 1: 1 1
# 2: 2 2
# 3: 3 3
# 4: 4 4
# 5: 5 5
# ---
# 499996: 499996 1010
# 499997: 499997 3175
# 499998: 499998 3996
# 499999: 499999 3653
# 500000: 500000 4217
使用更大的数据集大约需要半秒。
编辑:使用dcast的另一个版本,但速度慢了8倍:
res <- dcast(dt, id ~ value1 + value2, length)
res[, pattern_id :=.GRP, by = res[, -1] ][, .(id, pattern_id)]
我们可以试试下面的代码
dt[
,
q := toString(unlist(.SD)), id
][
,
pattern_id := .GRP, q
][
,
q := NULL
][]
或
dt[
,
q := toString(unlist(.SD)),
id
][
,
pattern_id := as.integer(factor(match(q, q)))
][
,
q := NULL
][]
这给出了
id value1 value2 pattern_id
1: a 1 0 1
2: a 1 3 1
3: b 1 0 2
4: b 2 3 2
5: c 1 0 1
6: c 1 3 1
这里有一些不依赖于每个 id 的基准,这些 id 必须标识两行,我在下面发布结果。
library(data.table)
set.seed(0)
size <- 500000
dt <- data.table(
id = rep(1:(size / 2), each = 2),
value1 = sample(1:10, size, replace = TRUE),
value2 = sample(1:10, size, replace = TRUE)
)
my_solution <- function(x) {
x <- x[, .(data = list(.SD)), by = id]
unique_groups <- unique(x$data)
x[, pattern_id := match(data, unique_groups)]
x[, data := NULL]
x[]
}
langtang_solution <- function(x) {
x <- x[, .(data = paste0(value1, "|", value2, collapse = ";")), by = id]
x[, pattern_id := .GRP, by = data]
x[, data := NULL]
x[]
}
thomasiscoding_solution <- function(x) {
x <- x[, .(data = toString(unlist(.SD))), by = id]
x[, pattern_id := .GRP, by = data]
x[, data := NULL]
x[]
}
identical(my_solution(dt), langtang_solution(dt))
#> [1] TRUE
identical(my_solution(dt), thomasiscoding_solution(dt))
#> [1] TRUE
microbenchmark::microbenchmark(
my_solution(dt),
langtang_solution(dt),
thomasiscoding_solution(dt),
times = 50L
)
#> Unit: seconds
#> expr min lq mean median uq
#> my_solution(dt) 3.174106 3.566495 3.818829 3.793850 4.015176
#> langtang_solution(dt) 1.369860 1.467013 1.596558 1.529327 1.649607
#> thomasiscoding_solution(dt) 3.014511 3.154224 3.280713 3.256732 3.370015
#> max neval
#> 4.525275 50
#> 2.279064 50
#> 3.681657 50
这非常丰富。我不知道 .GRP
,在我的测试中,它的表现与 match()
非常相似,尽管(非常小)好一点。最好的答案似乎是使用 paste()
将组转换为字符串,然后根据该字符串找到组。