Оптимизация расчета расстояния в R

Я хотел бы знать, есть ли способ оптимизировать процесс расчета расстояния ниже. Я оставил небольшой пример ниже, однако я работаю с электронной таблицей, содержащей более 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

Сравнение

> df$cluster <- clusters 
> df
   Industries Latitude Longitude cluster
1           1    -23.8     -49.6       1
2           2    -23.8     -49.6       1
3           3    -23.9     -49.6       2
4           4    -23.9     -49.6       2
5           5    -23.9     -49.6       2
6           6    -23.9     -49.6       2
7           7    -23.9     -49.6       2
8           8    -23.9     -49.6       2
9           9    -23.9     -49.6       2
10         10    -23.9     -49.6       2
11         11    -23.9     -49.7       3
12         12    -23.9     -49.7       3
13         13    -23.9     -49.7       3
14         14    -23.9     -49.7       3
15         15    -23.9     -49.7       3
16         16    -23.9     -49.6       2
17         17    -23.9     -49.6       2
18         18    -23.9     -49.6       2
19         19    -23.9     -49.6       2

> clustered_df
   Industries Latitude Longitude cluster     Dist Cluster
1          11    -23.9     -49.7       3     0.00       1
2          12    -23.9     -49.7       3     0.00       1
3          13    -23.9     -49.7       3     0.00       1
4          14    -23.9     -49.7       3     0.00       1
5          15    -23.9     -49.7       3     0.00       1
6           3    -23.9     -49.6       2 10183.02       2
7           4    -23.9     -49.6       2     0.00       2
8           5    -23.9     -49.6       2     0.00       2
9           6    -23.9     -49.6       2     0.00       2
10          7    -23.9     -49.6       2     0.00       2
11          8    -23.9     -49.6       2     0.00       2
12          9    -23.9     -49.6       2     0.00       2
13         10    -23.9     -49.6       2     0.00       2
14         16    -23.9     -49.6       2     0.00       2
15         17    -23.9     -49.6       2     0.00       2
16         18    -23.9     -49.6       2     0.00       2
17         19    -23.9     -49.6       2     0.00       2
18          1    -23.8     -49.6       1 11075.61       3
19          2    -23.8     -49.6       1     0.00       3

r distance geosphere
person Jose    schedule 28.05.2020    source источник
comment
Ваш код не имеет особого смысла. Из предыдущих вопросов я знаю, что вы пытаетесь наметить время в пути между определенными точками. Здесь вы используете расстояния Большого круга. Возможно, использование OSRM для измерения времени в пути / расстояния между точками более подходит?   -  person hello_friend    schedule 28.05.2020
comment
Спасибо другу за ответ. Я попытался привести очень краткий пример, не знаю, было ли это понятно. Я использую иерархическую кластеризацию, где необходимо вычислить расстояние между всеми точками перед созданием кластеров. Я хотел бы знать, можно ли вычислить расстояние более быстрым способом, я слышал, что он имеет функцию гаверсинуса пакета пространственного риска (который реализован в Rcpp), как правило, быстрее, но я пытался, у меня не получилось ' т. Пакет Osrm, который я не пробовал для этой цели в приведенном выше примере, но могу попробовать.   -  person Jose    schedule 28.05.2020
comment
Могу я порекомендовать прочитать документацию по OSRM. cran.r-project.org/web/packages/osrm/ readme / README.html   -  person hello_friend    schedule 28.05.2020
comment
Пожалуйста, посмотрите мое решение ниже, проголосуйте за и примите ответ, если он сделал то, что вам нужно!   -  person hello_friend    schedule 29.05.2020
comment
Спасибо за ответ. На данный момент у меня нет компьютера, но как только я его протестирую, я дам вам знать.   -  person Jose    schedule 29.05.2020
comment
Привет друг, я принял твой ответ. Я просто не понял нескольких вещей: я не совсем понял этот расчет переменной d. Из того, что я получил, у меня есть только один столбец с расстоянием. Разве это не было бы расстоянием от всех точек? А во-вторых, мне нужно использовать функцию hclust, поскольку это функция, соответствующая иерархической кластеризации.   -  person Jose    schedule 29.05.2020
comment
Lon lats упорядочены, мы получаем расстояния только между каждой точкой и следующей, а затем мы определяем, превышает ли это расстояние между точками 1 / k * 100 процентов значений. Мой вопрос к вам: зачем вам делать расстояния / hclust между всеми значениями, если они отсортированы? В этом случае, если расстояние между каждым значением вычисляется, не приводит ли это к тому же результату? Из приведенного выше кода после вычисления матриц для обоих шагов вы затем повторно используете только вектор кластера.   -  person hello_friend    schedule 30.05.2020
comment
Спасибо за ответ и объяснение. Я сомневаюсь в этом только потому, что есть отрасли, которые не были в одном кластере. Пожалуйста, посмотрите на код, который я вставил выше, сравнивая два, как первый способ, которым я это сделал, так и то, как вы это сделали. В первом случае отрасли 1 и 2 находятся в кластере 1, во втором - в кластере 3. Вы можете это изменить? И еще один вопрос, чтобы знать, можно ли вставить переменную d, которую вы сделали для функции hclust?   -  person Jose    schedule 30.05.2020
comment
почему номер кластера имеет значение? Правильно ли сгруппированы отрасли в полном наборе данных? Если у вас есть дополнительные вопросы, напишите ссылку на них, и я отвечу на них!   -  person hello_friend    schedule 30.05.2020

Ответы (1)


arrow_upward
2
arrow_downward

@Jose Возможно, не так хорошо математически (с точки зрения кластеризации), но (в целом) лучше измерить расстояния большого круга (формулы Винсенти). И ~ в 8 раз быстрее для достижения (что я думаю, ваш желаемый результат) - (просто используя ваши образцы данных).

# 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()
person hello_friend    schedule 29.05.2020