Question

我有一个data.table，在单位多维数据集中包含10,000个点（对于此示例）的x，y，z值，每个点都有一个对应的属性（称为P）。我使用了nn2包中的RANN来查找原始data.frame（作为一个原始data.frame返回的半径0.075单位内的每个点的k个邻居（最多50个）索引）矩阵）。

library(RANN)
library(data.table)

set.seed(1L) # for reproducible data
DATA <- data.table(runif(10000, 0,1), 
                   runif(10000, 0,1), 
                   runif(10000, 0,1), 
                   runif(10000, 10,30))
colnames(DATA)<-c("x","y","z","P")
nn.idx <- nn2(DATA[,1:3], DATA[,1:3], k=50, 
              treetype = "kd", searchtype = "radius", 
              radius = 0.075)$nn.idx

以下for循环完成了这项工作，但我想知道是否有任何方法可以通过矢量化来加快速度，因为当应用于＆gt;数百万点时这不会扩展？简而言之，我想使用nn.idx从P获取相应的DATA值并计算平均P，然后将其分配到DATA中的新列} mean.P

for(index in 1:nrow(DATA))
  DATA$mean.P[index]<-mean(DATA[nn.idx[index,], P])

为了便于说明，下面的代码说明了我要计算的内容 - 对于所有点（灰点），计算给定点周围的球体中所有点（橙色+红点）的平均值（红点））并将其分配给该点（红点）。迭代所有点，但以有效的方式进行，可以扩展大数据集。

library(rgl)
rgl.open()
rgl.points(DATA[1500,1], DATA[1500,2], DATA[1500,3], color ="red")
rgl.points(DATA[nn.idx[1500,],1:3], color ="orange", add=T)
rgl.points(DATA[,1:3], color ="lightgray", alpha=0.1, add=T)

我从未花费太多时间在我的生活中有效地渲染单个循环！另外，我并不反对使用c ++和Rcpp来解决这个问题，但我想我先问一下这里是否有一种方法可以让R缩放更快。提前致谢！

Answer 1

这是一种速度提高近100倍的解决方案。我不完全理解为什么改进如此之大，但也许其中一位真正的数据专家可以对此发表评论。

library(RANN)
library(data.table)

set.seed(1L) # for reproducible data
DATA <- data.table(runif(10000, 0,1), 
                   runif(10000, 0,1), 
                   runif(10000, 0,1), 
                   runif(10000, 10,30))
colnames(DATA)<-c("x","y","z","P")
nn.idx <- nn2(DATA[,1:3], DATA[,1:3], k=50, 
              treetype = "kd", searchtype = "radius", 
              radius = 0.075)$nn.idx

# (1)
# Timing for original loop.
system.time(for(index in 1:nrow(DATA)) {
    DATA$mean.P[index] <- mean(DATA[nn.idx[index,], P])
})
#    user  system elapsed 
#   7.830   0.850   8.684 

# (2)
# Use `set()` instead of `$<-` and `[<-`.
system.time({for(index in 1:nrow(DATA)) {
    set(DATA, i=index, j="mean_P_2", value=mean(DATA[nn.idx[index, ], P]))
}})
#    user  system elapsed 
#   3.405   0.008   3.417

正如您所看到的，只需在原始循环中替换data.table特定的set()函数，就可以有2倍的改进。

接下来，我尝试将所有功能放入data.table特定的函数（主要在data.table []语法中）。我还将P值放入向量中，因为访问向量中的值通常比对data.frames或data.tables上的类似操作快得多。

# (3)
# Add row index.
DATA[, row_idx:=seq(nrow(DATA))]

# Isolate P values in a vector, because vector access is cheaper
# than data.table or data.frame access.
P_vec = DATA$P

system.time({
    # Create a list column where each element is a vector of 50 integer indexes.
    DATA[, nn_idx:=lapply(row_idx, function(i) nn.idx[i, ])]
    # Use `:=` and `by=` to internalize the loop within `[.data.table`.
    DATA[, mean_P_3:=mean(P_vec[nn_idx[[1]]]), by=row_idx]
})
#    user  system elapsed 
#   0.092   0.002   0.095 

# All results are identical.
all.equal(DATA$mean.P, DATA$mean_P_2)
# [1] TRUE
all.equal(DATA$mean.P, DATA$mean_P_3)
# [1] TRUE

与原始循环相比，速度提高了近100倍。

似乎可以很好地扩展到100万个数据点：

# Try with 1 million data points.
set.seed(1L) # for reproducible data
DATA2 <- data.table(runif(1e6, 0,1), 
                    runif(1e6, 0,1), 
                    runif(1e6, 0,1), 
                    runif(1e6, 10,30))
colnames(DATA2) <- c("x","y","z","P")

system.time({
    nn.idx2 <- nn2(DATA2[,1:3], DATA2[,1:3], k=50, 
                   treetype = "kd", searchtype = "radius", 
                   radius = 0.075)$nn.idx
})
#    user  system elapsed 
# 346.603   1.883 349.708 


DATA2[, row_idx:=seq(nrow(DATA2))]
P_vec = DATA2$P

system.time({
    DATA2[, nn_idx:=lapply(row_idx, function(i) nn.idx2[i, ])]
    DATA2[, mean_P:=mean(P_vec[nn_idx[[1]]]), by=row_idx]
})
#    user  system elapsed 
#  15.685   0.587  16.297

计时是在2011年macbook pro（Sandy Bridge 2.2Ghz）的单核上完成的。 RAM使用率保持在1.5 GB以下。

Answer 2

这是使用melt()以长格式，连接和聚合重构索引矩阵的另一种解决方案：

long <- melt(as.data.table(nn.idx)[, pt := .I], measure.vars = patterns("V"))
tmp <- long[DATA[, pt := .I], on = .(value = pt)][, mean(P), by = .(pt)][order(pt), V1]
DATA[, mean.P := tmp][, pt := NULL][]

解释

索引矩阵nn.idx将转换为data.table并获得列pt，这是点的行ID。然后矩阵从宽到长格式重新整形。

tmp是相邻点的平均值的向量。通过将DATA与long正确连接以匹配最近邻点（在value列中）的索引与预先附加到DATA的点索引，可以找到这些内容。

最后一步是将结果作为DATA中的新列附加。

变式2

或者，可以使用第二个连接附加中间结果：

long <- melt(as.data.table(nn.idx)[, pt := .I], measure.vars = patterns("V"))
    long[DATA[, pt := .I], on = .(value = pt)][, mean(P), by = .(pt)][DATA, on = "pt"]

使用矩阵指定的data.table列值的平均值

2 个答案:

解释

变式2