我正在尝试将权重应用于data.table
中的数字矢量。权重来自每个点与所有其他点的欧式距离。如果一个点与另一个点接近,则分配给它们的权重将更高,如果两个点之间的距离大于阈值,则权重将为0,分配给一个点与自身之间的距离的权重为10000
我可以用下面的代码来说明:
library(data.table)
library(dplyr)
library(tictoc)
set.seed(42)
df <- data.table(
LAT = rnorm(500, 42),
LONG = rnorm(500, -72),
points = rnorm(500)
)
df2 <- copy(df) # for new solution
d <- as.matrix(dist(df[, .(LAT, LONG)])) # compute distance matrix
# function to calculate the weights
func <- function(j, cols, threshold) {
N <- which(d[j, ] <= threshold) # find points whose distances are below threshold
K <- (1 / (d[j, N] ^ 2)) # calculate weights, which are inversely proportional to distance, lower distance, higher the weight
K[which(d[j, N] == 0)] <- 10000 # weight to itself is 10000
return((K%*% as.matrix(df[N, ..cols])) / sum(K)) # compute weighted point for 1 row
}
tic('Old way')
# compute the weighted point calculation for every row
result <- tapply(1:nrow(df), 1:nrow(df), function(i) func(i, 'points', 0.5))
df[, 'weighted_points' := result] # assign the results back to data.table
toc()
当前函数仅适用于少量点,但是计算约220K行的加权点会花费更长的时间。
我想出了另一种解决方案,可以将时间缩短一半,但我认为仍然可以改进。
d <- as.matrix(dist(df[, .(LAT, LONG)]))
df2[, 'weighted_points' := points]
dt <- as.data.table(d)
cols <- names(dt)
tic('New way')
# compute the weights
dt[, (cols) := lapply(.SD, function(x) case_when(
x == 0 ~ 10000,
x <= 0.5 ~ 1 / (x^2),
TRUE ~ 0)), .SDcols = cols]
# compute the weighted point for each row
for (i in 1L:nrow(dt)) {
set(df2, i, 'weighted_points', value = sum(df2[['points']] * dt[[i]]) / sum(dt[[i]]))
}
toc()
round(sum(df$weighted_points - df2$weighted_points), 0)
对于这个较小的数据集,时间差异可能很小,但是我已经使用实际数据集测试了时间,并且新方法要快得多。
我的问题是,如何使新方法更快?我知道我正在使用case_when
中的dplyr
,这可能会使事情变慢,以换取可读性,但是在data.table
中我还有其他事情做得不好吗?
答案 0 :(得分:0)
从数据分析师的角度来看,我认为您可以通过近似表示平均距离和接近点来改进代码。
一旦我与NCDC站点位置一起工作,并试图找到彼此关闭的站点,因为存在太多的站点,这非常耗时。我想到一个想法,当我得到dist
的每个点的坐标后,我就将它们排名并设定阈值“我要为实际权重计算选择多少个站点”。
例如,在排名之后,获得50个最接近的点(在排名内)并分别赋予它们权重,其他点将获得0权重。
希望这会有所帮助