Объединить и построить несколько изохрон - PullRequest
Новая
       74

Объединить и построить несколько изохрон

3 голосов
/ 02 июня 2019

Что я люблю делать

Мне нравится строить изохроны из нескольких мест на карте, чтобы я мог визуально найти время в пути от произвольного города до ближайшего местоположения. Он должен выглядеть как 2D график плотности ядра: 

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

Как я могу объединить эти изохроны, чтобы они не перекрывались?

1 Ответ

1 голос
/ 03 июня 2019

Действительно классный вопрос. То, что вы хотите сделать, это объединить фигуры по идентификатору, чтобы все 0-30-минутные области были одной формой, все 30-60-минутные области - другой, и так далее. Есть способы сделать это с другими пространственными пакетами, но он, кажется, хорошо подходит для sf, который использует функции dplyr в стиле.

После создания isochrone вы можете преобразовать его в объект sf, сделать метку расстояния того же типа, сгруппировать по идентификатору и вызвать 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"))

Я не уверен, что случилось с областями, которые имеют резкие вертикальные края, но они есть и на вашем графике.

...