这篇文章由三部分组成：
- 原始答案（具有两个 ID 列的非 equi 自连接）
- 第一次编辑（具有可变 ID 列数的非 equi 自连接）
- 第二次编辑（6 种不同问题大小的不同方法的基准）
原答案：具有两个 ID 列的非 equi 自连接
为了完整起见，这里有一个解决方案，它使用了熔融数据的非等自连接（重新整形为长格式）：
library(data.table)
mdt <- melt(DT, id.vars = c("ID1", "ID2"))
res <- mdt[mdt, on = .(ID1, ID2, variable < variable), nomatch = NULL,
.(ID.new = paste(x.variable, i.variable, sep = " - "),
ID1, ID2, value.left = x.value, value.right = i.value)]
all.equal(res, DT.output, ignore.row.order = TRUE)
[1] TRUE
这种方法类似于r2evans' answer，但避免了笛卡尔连接。我已经避免将基准测试结果显示为对 6 行 5 列的样本数据集进行基准测试的相关性有限。
编辑 1：具有可变 ID 列数的非 equi 自连接
OP 已要求 ID 列的数量可以变化（事实上，ID 列的名称作为参数传递给 OP 自己的函数）。
non-equi 自连接可以被增强以处理任意数量的 ID 列：
library(data.table)
id_cols <- c("ID1", "ID2")
mdt <- melt(DT, id.vars = id_cols)
res <- mdt[mdt, on = c(id_cols, "variable < variable"), nomatch = NULL,
c(.(ID.new = paste(x.variable, i.variable, sep = " - "),
value.left = x.value, value.right = i.value), .SD),
.SDcols = id_cols]
all.equal(res, DT.output, ignore.col.order = TRUE, ignore.row.order = TRUE)
[1] TRUE
注意，在这里使用.SD 是安全的，因为.SDcols 只选择那些已经用于加入的列（由id_cols 指定）。
编辑 2：变化问题规模的基准
到目前为止，r2evans 和 tjebo 提供的基准测试仅使用具有 2 个 id 列、3 个数字列和 6 行的原始数据集。由于问题规模较小，这些基准比较开销，但不能代表较大问题规模的性能。
有 3 个不同的参数来描述问题的大小：
- 样本数据集
DT的行数nr，
- 数字列
nc 的数量，从中创建成对行，以及
- id 列数
ni。
最终结果由nc * (nc - 1) / 2 * nr 行和ni + 3 列组成。
通过使用bench 包中的press() 函数，我们可以轻松执行一组具有不同问题规模的基准测试。
基准测试中包含 6 种不同的方法：
所有方法都实现为使用 2 个参数调用的函数，分别是数据集 DT 或 DF，以及具有任意 id 列名称的字符向量。
pernkf <- function(data, ID.cols){
data <- data.table(data)
# Which of the columns are ID columns
ids <- which(colnames(data) %in% ID.cols)
# Obtain all pairwise combinations of numeric columns into a list
numeric.combs <- combn(x = data.table(data)[,!ids, with = FALSE], m = 2, simplify = FALSE)
id.cols <- data[,ids, with = FALSE]
# bind the ID columns to each pairwise combination of numeric columns inside the list
bind.columns.each.numeric.comb <- lapply(X = numeric.combs, FUN = function(x) cbind(id.cols,x))
# Create generic names for the numeric columns so that rbindlist() may be applied. In addition we make a new column that groups based on which columns we are considering
generalize <- suppressWarnings(lapply(X = bind.columns.each.numeric.comb, FUN = function(x)
setattr(x = x[,ID.new:=paste(colnames(x[,!ids,with=FALSE]),collapse=" - ")], name =
'names', value = c(ID.cols,"value.left","value.right","ID.new"))))
return(rbindlist(l=generalize))
}
r2evans = \(DT, id_cols) {
DTlong <- melt(DT, id.vars = id_cols, variable.factor = FALSE)
DTlong[DTlong, on = c(id_cols), allow.cartesian = TRUE
][variable < i.variable,
][, .(ID.new = paste(variable, i.variable, sep = " - "), setnames(.SD, id_cols),
value.left = value, value.right = i.value), .SDcols = id_cols
]
}
tjebo <- \(data, ID.cols) {
ids <- which(colnames(data) %in% ID.cols)
## you can loop over the combinations directly
new_dat <- combn(data[-ids], 2, function(x) {
new_x <- setNames(x, paste("value", c("left", "right"), sep = "."))
## use paste with collapse for the ID.new
new_x$ID.new <- paste(names(x), collapse = " - ")
new_x
}, simplify = FALSE)
## bind it with the old ID columns, outside the loop (bit faster)
cbind(do.call(rbind, new_dat), data[ids])
}
nej <- \(DT, id_cols) {
mdt <- melt(DT, id.vars = id_cols)
mdt[mdt, on = c(id_cols, "variable < variable"), nomatch = NULL,
.(setnames(.SD, id_cols), ID.new = paste(x.variable, i.variable, sep = " - "),
value.left = x.value, value.right = i.value),
.SDcols = id_cols]
}
dtc <- \(DT, id_cols) {
combn(setdiff(colnames(DT), id_cols), 2,
\(x) DT[, ..x][, ID.new := paste(x, collapse = " - ")],
simplify = FALSE) |>
rbindlist(use.names = FALSE) |>
setnames(1:2, c("value.left", "value.right")) |>
cbind(DT[, ..id_cols])
}
mvl <- \(DT, id_cols) {
num_cols <- setdiff(colnames(DT), id_cols)
combos <- combn(num_cols, 2L, simplify = TRUE)
id_new_levels <- apply(combos, 2, paste, collapse = " - ")
melt(DT, measure.vars = list(combos[1L, ],combos[2L, ]),
value.name = c("value.left", "value.right"), variable.name = "ID.new")[
, ID.new := as.character(`levels<-`(ID.new, id_new_levels))]
}
Peace Wang 和 TarJae 的两种方法已被省略，因为我无法将它们转换为可扩展的函数。
在对press() 的调用中，nr 的行数从 10 变化到 100'000，数字列数 nc 从 3 变化到 10。相应地，生成的数据集的行数会有所不同从 30 到 450 万行。所有运行都使用 3 个 id 列来验证 ni 是否可扩展（不限于 2 个）。
检查功能设置为忽略不同的行和/或列顺序，因为这些可能因不同的方法而异。
library(bench)
bm <- press(
nr = c(10L, 1000L, 100000L),
nc = c(3L, 5L, 10L),
{
ni <- 3L
DT <- data.table()
id_cols <- sprintf("ID%01i", seq(ni))
# append id cols
for (id in id_cols) set(DT, , id, seq(nr))
# append data cols
for (j in seq(nc)) {
col_name <- sprintf("NAME%04i", j)
set(DT, , col_name, seq(nr) + (j / 1000))
}
DF <- as.data.frame(DT)
mark(
pernkf(DT, id_cols),
r2evans(DT, id_cols),
tjebo(DF, id_cols),
nej(DT, id_cols),
dtc(DT, id_cols),
mvl(DT, id_cols),
check = \(x,y) all.equal(x, setDT(y), ignore.row.order = TRUE, ignore.col.order = TRUE),
min_iterations = 3L
)
}
)
基准时间由
可视化
ggplot2::autoplot(bm)
（注意对数时间刻度）。
几乎总是，mvl() 是最快的方法。仅对于具有 3 个数字列和最多 1000 行的最小问题大小，tjebo() 稍微快一些。对于 100'000 行的大问题，dtc() 和 pernkf() 分别是第二和第三。
下一张图表显示了性能如何随数字列数 nc 变化：
library(ggplot2)
ggplot(bm) +
aes(nc, median, colour = attr(expression, "description")) +
geom_point() +
geom_line() +
scale_x_log10() +
labs(colour = "expression") +
facet_wrap(~nr, scales = "free_y") +
ggtitle("Median run time")
（注意 log-log 尺度和 facets 的独立时间尺度）
tjebo() 的运行时间使用nc 比任何其他方法增加得更快。对于某些用例，mvl() 比任何其他方法都要快一个数量级。
一个经常被忽视的方面是内存消耗。下图显示了内存分配如何随问题大小而变化：
ggplot(bm) +
aes(nc, mem_alloc, colour = attr(expression, "description")) +
geom_point() +
geom_line() +
scale_x_log10() +
labs(colour = "expression") +
facet_wrap(~nr, scales = "free_y") +
ggtitle("Memory allocation")
（注意对数刻度和 y 轴上的独立刻度）
每个用例的最佳和最差方法之间的内存分配差异非常大，大约是 7 到 8 倍。同样，tjebo() 与nc 的内存分配增长最快。对于大型问题，mvl() 分配的内存比任何其他方法都要少，然后是dtc() 和pernkf()。