我有一个 200k 行数据集，其中包含出发地和目的地的坐标。我有一个 R 闪亮的应用程序，带有传单地图，可以在这些坐标上显示圆圈，尽管坐标数量很大，但效果很好。
这是数据的简化示例。每行包含出行id、出发地经纬度、目的地经纬度。
id lat_begin lat_end lng_begin lng_end
1 1 46.49 46.27 2.65 7.66
2 2 45.94 49.24 7.94 0.76
3 3 48.07 49.50 2.05 2.61
4 4 46.98 48.94 0.80 5.76
5 5 46.94 48.82 7.36 6.40
6 6 47.37 48.52 5.83 7.00
现在我的目标是在每个出发地和目的地之间添加线路，即 20 万条线路。
我在 1000 行样本上尝试了几种想法，但它总是花费太多时间，并且显示 200k 行需要几个小时。
第一种方法：
addPolylines 函数上的 for 循环
library(dplyr)
library(shiny)
library(leaflet)
n = 1000 # small number of lines
data_dots = data.frame(id = 1:n,
lat_begin = round(runif(n,45,50),2),
lat_end = round(runif(n,45,50),2),
lng_begin = round(runif(n,0,8),2),
lng_end = round(runif(n,0,8),2))
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output) {
# Initiate the map
output$map <- renderLeaflet({
myMap = leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng=3.07381,lat=45.7829,zoom=5) %>%
# add dots
addCircles(data = data_dots, ~c(lng_begin,lng_end) , ~c(lat_begin,lat_end),
stroke=FALSE, fillOpacity = 0.7)
# add lines
for(i in 1:n){
myMap = myMap %>%
addPolylines(data = data_dots[i,],
lng= ~ c(lng_begin, lng_end),
lat= ~ c(lat_begin, lat_end),
color = 'blue',
weight = 1)
}
myMap
# also tried with apply
# lapply(data_dots$id,
# function(x) {
# addPolylines(myMap,
# data = data_dots[data_dots$id == x, ],
# lng = ~c(lng_begin, lng_end),
# lat = ~c(lat_begin, lat_end),
# color = 'blue',
# weight = 1)
# })
# myMap
})
}
shinyApp(ui = ui, server = server)
第二种方法：
创建空间线对象
library(dplyr)
library(shiny)
library(leaflet)
library(maptools)
library(sp)
n = 1000
data_dots = data.frame(id = 1:n,
lat_begin = round(runif(n,45,50),2),
lat_end = round(runif(n,45,50),2),
lng_begin = round(runif(n,0,8),2),
lng_end = round(runif(n,0,8),2))
begin <- data_dots %>%
select(id, lat_begin, lng_begin) %>%
rename(latitude = lat_begin, longitude = lng_begin)
end <- data_dots %>%
select(id, lat_end, lng_end) %>%
rename(latitude = lat_end, longitude =lng_end)
data_lines = bind_rows(begin, end)
# make data_lines a spatialdataframe
coordinates(data_lines) <- c('longitude', 'latitude')
# create a list per id
id_list <- sp::split(data_lines, data_lines[['id']])
id <- 1
#for each id, create a line that connects all points with that id
for ( i in id_list ) {
event.lines <- SpatialLines( list( Lines( Line( i[1]@coords ), ID = id ) ),
proj4string = CRS( "+init=epsg:4326" ) )
if ( id == 1 ) {
sp_lines <- event.lines
} else {
sp_lines <- spRbind( sp_lines, event.lines )
}
id <- id + 1
}
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output) {
# Initiate the map
output$map <- renderLeaflet({
myMap = leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng=3.07381,lat=45.7829,zoom=5) %>%
# add dots
addCircles(data = data_dots, ~c(lng_begin,lng_end) , ~c(lat_begin,lat_end),
stroke=FALSE, fillOpacity = 0.7) %>%
# add lines
addPolylines(data = sp_lines)
})
shinyApp(ui = ui, server = server)
每个案例需要几秒钟，有 1000 行。我可以用 200k 条线快速添加圆圈，但最大的问题是添加线。
