我喜欢做什么
我喜欢在地图上的多个位置绘制等时线,以便从视觉上找到从任意城镇到最近位置的行驶时间。它看起来应该像一个内核密度二维图:
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
data <- map2_dfr(locations$lon, locations$lat, ~ data.frame(lon = rnorm(10000, .x, 0.8),
lat = rnorm(10000, .y, 0.7)))
ger <- c(left = min(locations$lon) - 1, bottom = min(locations$lat) - 1,
right = max(locations$lon) + 1, top = max(locations$lat) + 1)
get_stamenmap(ger, zoom = 7, maptype = "toner-lite") %>%
ggmap() +
stat_density_2d(data = data, aes(x= lon, y = lat, fill = ..level.., alpha = ..level..),
geom = "polygon") +
scale_fill_distiller(palette = "Blues", direction = 1, guide = FALSE) +
scale_alpha_continuous(range = c(0.1,0.3), guide = FALSE)
我尝试了什么
您可以通过osrm轻松获取等时线,并通过传单进行绘制。但是,这些等时线彼此独立。当我绘制它们时,它们彼此重叠。
library(osrm)
library(leaflet)
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
isochrone <- map2(locations$lon, locations$lat,
~ osrmIsochrone(loc = c(.x, .y),
breaks = seq(0, 120, 30))) %>%
do.call(what = rbind)
isochrone@data$drive_times <- factor(paste(isochrone@data$min, "bis",
isochrone@data$max, "Minuten"))
factpal <- colorFactor("Blues", isochrone@data$drive_times, reverse = TRUE)
leaflet() %>%
setView(mean(locations$lon), mean(locations$lat), zoom = 7) %>%
addProviderTiles("Stamen.TonerLite") %>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",
fillColor = ~factpal(isochrone@data$drive_times),
weight = 0.5, fillOpacity = 0.6,
data = isochrone, popup = isochrone@data$drive_times,
group = "Drive Time") %>%
addLegend("bottomright", pal = factpal, values = isochrone@data$drive_time,
title = "Fahrtzeit")
如何合并这些等时线,使它们不重叠?
最佳答案
真的很酷的问题。您要做的是按ID合并形状,因此所有0-30分钟的区域都是一个形状,所有30-60分钟的区域都是另一个形状,依此类推。可以使用其他空间包来完成此操作,但是似乎很适合sf
,后者使用dplyr
样式的函数。
创建isochrone
后,可以将其转换为sf
对象,制作相同类型的距离标签,按ID分组,然后调用summarise
。汇总sf
对象时的默认值只是一个空间并集,因此您不需要在那里提供函数。
library(sf)
library(dplyr)
iso_sf <- st_as_sf(isochrone)
iso_union <- iso_sf %>%
mutate(label = paste(min, max, sep = "-")) %>%
group_by(id, label) %>%
summarise()
我没有方便的
leaflet
,所以这里只是默认的打印方法:plot(iso_union["label"], pal = RColorBrewer::brewer.pal(4, "Blues"))
我不确定垂直边缘突然变化的区域是怎么回事,但是这些区域也在您的绘图中。
关于r - 合并并绘制多个等时线,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/56417901/