速度优化-使用距离矩阵计算data.table中的加权列

Question

I am trying to apply weights to a numeric vector in a data.table . The weights come from the euclidean distances of each point with all the other points. If a point is close with another point, then the weights assigned to them will be higher, if the distance between 2 points are greater than a threshold then the weights will be 0, the weight assigned to the distance between a point and itself is 10000.

I can illustrate with the code below:

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()

The current function works well for small number of points, but it takes a lot longer to compute weighted points for about 220K rows.

I have come up with another solution that cuts down the time in half, but I think it can still be improved.

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)

The time differences may be small for this small data set, but I have tested the time using the real data set and the new way is quite a bit faster.

My question is, how can I make the new approach to be even faster? I know I am using case_when from dplyr which could make things slower in exchange for readability, but are there other things that I am not doing correctly in data.table that could help make it faster?

Answer 1

From data analyst side I think you could improve your code with an approximation for what mean distance and close points.

Once I worked with NCDC station locations and tried to find closes stations for each other because there were so many stations it was time-consuming. I came up with an idea that after I get dist of my coordinates of each point I just rank them up and put up threshold "how many stations I want to take for real weight calculation".

For example, after ranking take 50 closest points (within the rank) and put them weights respectively, other points will just get 0 weight.

Hope this helps