R

R,r,distance,geosphere,R,Distance,Geosphere,我想知道是否有任何方法可以优化下面的距离计算过程。我在下面留下了一个小例子,但是我正在使用一个超过6000行的电子表格,计算变量d需要相当长的时间。这将是可能的,以某种方式调整,以获得相同的结果,但在一个优化的方式 library(rdist) library(tictoc) library(geosphere) time<-tic() df<-structure(list(Industries=c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,1

我想知道是否有任何方法可以优化下面的距离计算过程。我在下面留下了一个小例子,但是我正在使用一个超过6000行的电子表格,计算变量d需要相当长的时间。这将是可能的,以某种方式调整,以获得相同的结果,但在一个优化的方式

library(rdist)
library(tictoc)
library(geosphere)

time<-tic()

df<-structure(list(Industries=c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, 
+ + -23.9, -23.9, -23.9, -23.9, -23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7, 
+ + -49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6)), class = "data.frame", row.names = c(NA, -19L))

k=3 
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average") 
clusters<-cutree(fit.average, k) 
nclusters<-matrix(table(clusters))  
df$cluster <- clusters 

time<-toc()

1.54 sec elapsed

d
          1        2        3        4        5        6        7        8
2      0.00                                                               
3  11075.61 11075.61                                                      
4  11075.61 11075.61     0.00                                             
5  11075.61 11075.61     0.00     0.00                                    
6  11075.61 11075.61     0.00     0.00     0.00                           
7  11075.61 11075.61     0.00     0.00     0.00     0.00                  
8  11075.61 11075.61     0.00     0.00     0.00     0.00     0.00         
9  11075.61 11075.61     0.00     0.00     0.00     0.00     0.00     0.00
10 11075.61 11075.61     0.00     0.00     0.00     0.00     0.00     0.00
11 15048.01 15048.01 10183.02 10183.02 10183.02 10183.02 10183.02 10183.02
12 15048.01 15048.01 10183.02 10183.02 10183.02 10183.02 10183.02 10183.02
13 15048.01 15048.01 10183.02 10183.02 10183.02 10183.02 10183.02 10183.02
14 15048.01 15048.01 10183.02 10183.02 10183.02 10183.02 10183.02 10183.02
15 15048.01 15048.01 10183.02 10183.02 10183.02 10183.02 10183.02 10183.02
16 11075.61 11075.61     0.00     0.00     0.00     0.00     0.00     0.00
17 11075.61 11075.61     0.00     0.00     0.00     0.00     0.00     0.00
18 11075.61 11075.61     0.00     0.00     0.00     0.00     0.00     0.00
19 11075.61 11075.61     0.00     0.00     0.00     0.00     0.00     0.00
          9       10       11       12       13       14       15       16
2                                                                         
3                                                                         
4                                                                         
5                                                                         
6                                                                         
7                                                                         
8                                                                         
9                                                                         
10     0.00                                                               
11 10183.02 10183.02                                                      
12 10183.02 10183.02     0.00                                             
13 10183.02 10183.02     0.00     0.00                                    
14 10183.02 10183.02     0.00     0.00     0.00                           
15 10183.02 10183.02     0.00     0.00     0.00     0.00                  
16     0.00     0.00 10183.02 10183.02 10183.02 10183.02 10183.02         
17     0.00     0.00 10183.02 10183.02 10183.02 10183.02 10183.02     0.00
18     0.00     0.00 10183.02 10183.02 10183.02 10183.02 10183.02     0.00
19     0.00     0.00 10183.02 10183.02 10183.02 10183.02 10183.02     0.00
         17       18
2                   
3                   
4                   
5                   
6                   
7                   
8                   
9                   
10                  
11                  
12                  
13                  
14                  
15                  
16                  
17                  
18     0.00         
19     0.00     0.00
比较
@Jose也许在聚类方面在数学上不那么可靠,但通常是Vincenty公式中大圆距离的更好度量。只需使用您的样本数据,就可以更快地达到我认为是您期望的结果

# Order the dataframe by Lon and Lat: ordered_df => data.frame
ordered_df <- 
  df %>% 
  arrange(., Longitude, Latitude)  

# Scalar valued at how many clusters we are expecting => integer vector
k = 3

# Matrix of co-ordinates: coordinates => matrix
coordinates <-   
  ordered_df %>% 
  select(Longitude, Latitude) %>% 
  as.matrix()

# Generate great circle distances between points and Long-Lat Matrix: d => data.frame
d <- data.frame(Dist = c(0, distVincentyEllipsoid(coordinates)))

# Segment the distances into groups: cluster => factor 
d$Cluster <- factor(cumsum(d$Dist > (quantile(d$Dist, 1/k))) + 1)

# Merge with base data: clustered_df => data.frame
clustered_df <- cbind(ordered_df, d)
库和示例数据:

library(geosphere)
library(dplyr)

df <- structure(list(Industries=c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19), 
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9),
Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7,-49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6)),
class = "data.frame", row.names = c(NA, -19L))
start_time <- Sys.time()

你的代码没有多大意义。从前面的问题中,我知道您正在尝试绘制特定点之间的驾驶时间。这里您使用的是大圆距离。也许使用OSRM测量点之间的驾驶时间/驾驶距离更合适?谢谢朋友的回答。我试图留下一个非常简短的例子,我不知道这是否可以理解。我使用的是分层聚类,在生成聚类之前需要计算所有点之间的距离。我想知道是否有可能以更快的方式计算距离,我听说它具有在Rcpp中实现的spatialrisk软件包的haversine函数,速度会更快,但我尝试了,但我做不到。在上面的示例中,我没有尝试过Osrm包,但是我可以尝试。我建议您阅读Osrm的文档。请查看下面我的解决方案,并投票表决,如果答案符合您的要求,请接受!谢谢你的回复。我现在没有电脑,但我一测试它,就会告诉你。
library(geosphere)
library(dplyr)

df <- structure(list(Industries=c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19), 
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9),
Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7,-49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6)),
class = "data.frame", row.names = c(NA, -19L))
start_time <- Sys.time()