R数据表中最近的“ n”滚动连接
使用data.table，我们可以使用roll = "nearest"将一个数据集中的值与另一个数据集中最接近的值连接起来。一些示例数据：
dt1 <- data.table(x = c(15,101), id1 = c("x", "y"))
dt2 <- data.table(x = c(10,50,100,200), id2 = c("a","b","c","d"))
使用roll = "nearest"，我可以将'dt1'中的每个'x'与最近的dt2中的'x'连接起来：
dt2[dt1, roll = "nearest", on = "x"]
# x id2 id1
# 1: 15 a x
# 2: 101 c y
例如对于“ dt1”中的x = 15，“ dt2”中最接近的x值为x = 10，我们得到对应的“ id2”即"a"。
但是，如果我不想获得 n 个最近值，而不是得到一个 n 个最近的值怎么办？例如，如果我想要 2 最接近的x值，结果将是：
x id2 id1 roll
1: 15 a x nr1
2: 15 b x nr2
3: 101 c y nr1
4: 101 b y nr2
（“ nr”代表“最近”）
我想要一种适用于任何“ n”的通用方法（例如2个最近的点，3个最近的点等）。
编辑 我想知道是否有可能将其应用于多列连接，在多列连接中，连接将与前一列匹配，然后再获取最后一个连接列的最接近值。例如：
dt1 <- data.table(group=c(1,2), x=(c(15,101)), id1=c("x","y"))
dt2 <- data.table(group=c(1,2,2,3), x=c(10,50,100,200),id2=c("a","b","c","d"))
如果我加入on=c("group","x")，则该联接将首先在“组”上匹配，然后在“ x”上最接近，因此我希望结果是这样的：
x group id2 id1 roll
1: 15 1 a x nr1
2: 101 2 c y nr1
3: 101 2 b y nr2
5 个答案:
答案 0 :(得分：8)
这是非常原始的内容（我们逐行进行）：
n <- 2L
sen <- 1L:n
for (i in 1:nrow(dt1)) {
set(dt1, i, j = "nearest", list(which(frank(abs(dt1$x[i] - dt2$x)) %in% sen)))
}
dt1[, .(id1, nearest = unlist(nearest)), by = x
][, id2 := dt2$id2[nearest]
][, roll := paste0("nr", frank(abs(dt2$x[nearest] - x))), by = x][]
# x id1 nearest id2 roll
# 1: 15 x 1 a nr1
# 2: 15 x 2 b nr2
# 3: 101 y 2 b nr2
# 4: 101 y 3 c nr1
稍微干净：
dt1[,
{
nrank <- frank(abs(x - dt2$x), ties.method="first")
nearest <- which(nrank %in% sen)
.(x = x, id2 = dt2$id2[nearest], roll = paste0("nr", nrank[nearest]))
},
by = id1] # assumes unique ids.
数据：
dt1 <- data.table(x = c(15, 101), id1 = c("x", "y"))
dt2 <- data.table(x = c(10, 50, 100, 200), id2 = c("a", "b", "c", "d"))
编辑（由OP建议/编写） 使用多个键进行连接：
dt1[,
{
g <- group
dt_tmp <- dt2[dt2$group == g]
nrank <- frank(abs(x - dt_tmp$x), ties.method="first")
nearest <- which(nrank %in% sen)
.(x = x, id2 = dt_tmp$id2[nearest], roll = paste0("nr", nrank[nearest]))
},
by = id1]
答案 1 :(得分：6)
已编辑以更正顺序。
我不知道roll=将允许最近的n，但这是一个可能的解决方法：
dt1[, id2 := lapply(x, function(z) { r <- head(order(abs(z - dt2$x)), n = 2); dt2[ r, .(id2, nr = order(r)) ]; }) ]
as.data.table(tidyr::unnest(dt1, id2))
# x id1 id2 nr
# 1: 15 x a 1
# 2: 15 x b 2
# 3: 101 y c 2
# 4: 101 y b 1
（我使用tidyr::unnest是因为我认为它在这里很合适并且可以正常工作，并且data.table/#3672仍然处于打开状态。）
第二批数据：
dt1 = data.table(x = c(1, 5, 7), id1 = c("x", "y", "z"))
dt2 = data.table(x = c(2, 5, 6, 10), id2 = c(2, 5, 6, 10))
dt1[, id2 := lapply(x, function(z) { r <- head(order(abs(z - dt2$x)), n = 2); dt2[ r, .(id2, nr = order(r)) ]; }) ]
as.data.table(tidyr::unnest(dt1, id2))
# x id1 id2 nr
# 1: 1 x 2 1
# 2: 1 x 5 2
# 3: 5 y 5 1
# 4: 5 y 6 2
# 5: 7 z 6 2
# 6: 7 z 5 1
答案 2 :(得分：4)
这是使用滚动联接的另一种选择，没有额外的分组键（对我最初的天真的交叉联接构想进行了改进）
#for differentiating rows from both data.tables
dt1[, ID := .I]
dt2[, rn := .I]
#perform rolling join to find closest and
#then retrieve the +-n rows around that index from dt2
n <- 2L
adjacent <- dt2[dt1, on=.(x), roll="nearest", nomatch=0L, by=.EACHI,
c(.(ID=ID, id1=i.id1, val=i.x), dt2[unique(pmin(pmax(0L, seq(x.rn-n, x.rn+n, by=1L)), .N))])][,
(1L) := NULL]
#extract nth nearest
adjacent[order(abs(val-x)), head(.SD, n), keyby=ID]
输出：
ID id1 val x id2 rn
1: 1 x 15 10 a 1
2: 1 x 15 50 b 2
3: 2 y 101 100 c 3
4: 2 y 101 50 b 2
并使用Henrik的数据集：
dt1 = data.table(x = c(1, 5, 7), id1 = c("x", "y", "z"))
dt2 = data.table(x = c(2, 5, 6, 10), id2 = c(2, 5, 6, 10))
输出：
ID id1 val x id2 rn
1: 1 x 1 2 2 1
2: 1 x 1 5 5 2
3: 2 y 5 5 5 2
4: 2 y 5 6 6 3
5: 3 z 7 6 6 3
6: 3 z 7 5 5 2
还有Henrik的第二个数据集：
dt1 = data.table(x = 3L, id1="x")
dt2 = data.table(x = 1:2, id2=c("a","b"))
输出：
ID id1 val x id2 rn
1: 1 x 3 2 b 2
2: 1 x 3 1 a 1
并且加入其他分组密钥：
dt2[, rn := .I]
#perform rolling join to find closest and
#then retrieve the +-n rows around that index from dt2
n <- 2L
adjacent <- dt2[dt1, on=.(group, x), roll="nearest", by=.EACHI, {
xrn <- unique(pmax(0L, seq(x.rn-n, x.rn+n, by=1L)), .N)
c(.(id1=id1, x1=i.x),
dt2[.(group=i.group, rn=xrn), on=.(group, rn), nomatch=0L])
}][, (1L:2L) := NULL]
#extract nth nearest
adjacent[order(abs(x1-x)), head(.SD, 2L), keyby=id1] #use id1 to identify rows if its unique, otherwise create ID column like prev section
输出：
id1 x1 group x id2 rn
1: x 15 1 10 a 1
2: y 101 2 100 c 3
3: y 101 2 50 b 2
数据：
library(data.table)
dt1 <- data.table(group=c(1,2), x=(c(15,101)), id1=c("x","y"))
dt2 <- data.table(group=c(1,2,2,3), x=c(10,50,100,200), id2=c("a","b","c","d"))
答案 3 :(得分：3)
使用nabor::knn的 k个最近邻居：
library(nabor)
k = 2L
dt1[ , {
kn = knn(dt2$x2, x, k)
c(.SD[rep(seq.int(.N), k)],
dt2[as.vector(kn$nn.idx),
.(x2 = x, id2, nr = rep(seq.int(k), each = dt1[ ,.N]))])
}]
# x id1 x2 id2 nr
# 1: 15 x 10 a 1
# 2: 101 y 100 c 1
# 3: 15 x 50 b 2
# 4: 101 y 50 b 2
与@sindri_baldur和@ r2evans的答案相同，没有执行实际的联接（on = ），我们“仅”在j中做些事情。
时间
对于中等大小的数据（nrow(dt1)：1000； nrow(dt2)：10000）， knn 看起来更快：
# Unit: milliseconds
# expr min lq mean median uq max neval
# henrik 8.09383 10.19823 10.54504 10.2835 11.00029 13.72737 20
# chinsoon 2140.48116 2154.15559 2176.94620 2171.5824 2192.54536 2254.20244 20
# r2evans 4496.68625 4562.03011 4677.35214 4680.0699 4751.35237 4935.10655 20
# sindri 4194.93867 4397.76060 4406.29278 4402.7913 4432.76463 4490.82789 20
我还尝试对10倍大的数据进行一次评估，然后差异更加明显。
计时代码：
v = 1:1e7
n1 = 10^3
n2 = n1 * 10
set.seed(1)
dt1_0 = data.table(x = sample(v, n1))
dt2_0 = data.table(x = sample(v, n2))
setorder(dt1_0, x)
setorder(dt2_0, x)
# unique row id
dt1_0[ , id1 := 1:.N]
# To make it easier to see which `x` values are joined in `dt1` and `dt2`
dt2_0[ , id2 := x]
bm = microbenchmark(
henrik = {
dt1 = copy(dt1_0)
dt2 = copy(dt2_0)
k = 2L
d_henrik = dt1[ , {
kn = knn(dt2$x, x, k)
c(.SD[as.vector(row(kn$nn.idx))],
dt2[as.vector(kn$nn.idx),
.(id2, nr = as.vector(col(kn$nn.idx)))])
}]
},
chinsoon = {
dt1 = copy(dt1_0)
dt2 = copy(dt2_0)
dt1[, ID := .I]
dt2[, rn := .I]
n <- 2L
adjacent <- dt2[dt1, on=.(x), roll="nearest", nomatch=0L, by=.EACHI,
c(.(ID=ID, id1=i.id1, val=i.x),
dt2[unique(pmin(pmax(0L, seq(x.rn-n, x.rn+n, by=1L)), .N))])][,(1L) := NULL]
d_chinsoon = adjacent[order(abs(val-x)), head(.SD, n), keyby=ID]
},
r2evans = {
dt1 = copy(dt1_0)
dt2 = copy(dt2_0)
dt1[, id2 := lapply(x, function(z) { r <- head(order(abs(z - dt2$x)), n = 2); dt2[ r, .(id2, nr = order(r)) ]; }) ]
d_r2evans = as.data.table(tidyr::unnest(dt1, id2))
},
sindri = {
dt1 = copy(dt1_0)
dt2 = copy(dt2_0)
n <- 2L
sen <- 1:n
d_sindri = dt1[ ,
{
nrank <- frank(abs(x - dt2$x), ties.method="first")
nearest <- which(nrank %in% sen)
.(x = x, id2 = dt2$id2[nearest], roll = paste0("nr", nrank[nearest]))
}, by = id1]
}
, times = 20L)
# Unit: milliseconds
# expr min lq mean median uq max neval
# henrik 8.09383 10.19823 10.54504 10.2835 11.00029 13.72737 20
# chinsoon 2140.48116 2154.15559 2176.94620 2171.5824 2192.54536 2254.20244 20
# r2evans 4496.68625 4562.03011 4677.35214 4680.0699 4751.35237 4935.10655 20
# sindri 4194.93867 4397.76060 4406.29278 4402.7913 4432.76463 4490.82789 20
经过某种排序后检查是否相等：
setorder(d_henrik, x)
all.equal(d_henrik$id2, d_chinsoon$id2)
# TRUE
all.equal(d_henrik$id2, d_r2evans$id2)
# TRUE
setorder(d_sindri, x, roll)
all.equal(d_henrik$id2, d_sindri$id2)
# TRUE
其他分组变量
快速而又肮脏的解决方法，用于附加的连接变量； knn 按组完成：
d1 = data.table(g = 1:2, x = c(1, 5))
d2 = data.table(g = c(1L, 1L, 2L, 2L, 2L, 3L),
x = c(2, 5, 2, 3, 6, 10))
d1
# g x
# 1: 1 4
# 2: 2 4
d2
# g x
# 1: 1 2
# 2: 1 4 # nr 1
# 3: 1 5 # nr 2
# 4: 2 0
# 5: 2 1 # nr 2
# 6: 2 6 # nr 1
# 7: 3 10
d1[ , {
gg = g
kn = knn(d2[g == gg, x], x, k)
c(.SD[rep(seq.int(.N), k)],
d2[g == gg][as.vector(kn$nn.idx),
.(x2 = x, nr = rep(seq.int(k), each = d1[g == gg, .N]))])
}, by = g]
# g x x2 nr
# 1: 1 4 4 1
# 2: 1 4 5 2
# 3: 2 4 6 1
# 4: 2 4 1 2
答案 4 :(得分：0)
您可以使用软件包$ gcloud sql operations list --instance=$DB_INSTANCE_NAME --filter='NOT status:done' --format='value(name)' | xargs -r gcloud sql operations wait
$ gcloud sql ... # whatever you need to do
获取n个最近的邻居：
distances
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？