如何在R中使用OSRM绘制多个等时线多边形？

Question

我已成功设法使用此示例帖子在R中重新创建驱动时间多边形

上面的帖子只涉及一个带有等时线的单个多边形

问题 - 我想在5个不同的地图点上绘制多个驾驶时间多边形

通过创建5个单独的等时线，然后在我的Leaflet Map中添加5个多边形，我设法以非常费力的方式完成了这项工作。

#Preparing multiple dependancies----
packages <- c("readxl","dplyr","leaflet","htmltools", "sp", "osrm")
install.packages(packages)
lapply(packages, library,character.only=TRUE)

###

#Loading in Locations----
Location <- read_excel("filepath.xlsx", sheet=1)

###

#Extract Lon and Lat and create spatial dataframe
xy <- Location[, c(3,4)]

spatialdf <- SpatialPointsDataFrame(coords = xy, data = Location, proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))
class(spatialdf)

#Create Isochrone points
iso1 <- osrmIsochrone(loc = c(-2.3827439,53.425705), breaks = seq(from = 0, to = 60, by = 5))
iso2 <- osrmIsochrone(loc = c(-0.85074928,51.325871), breaks = seq(from = 0, to = 60, by = 5)) 
iso3 <- osrmIsochrone(loc = c(-2.939367,51.570344), breaks = seq(from = 0, to = 60, by = 5)) 
iso4 <- osrmIsochrone(loc = c(-3.9868026,55.823102), breaks = seq(from = 0, to = 60, by = 5)) 
iso5 <- osrmIsochrone(loc = c(-0.92104073,53.709006), breaks = seq(from = 0, to = 60, by = 5))


#Create Drive Time Interval descriptions
iso1@data$drive_times <- factor(paste(iso1@data$min, "to", iso1@data$max, "mins"))
iso2@data$drive_times <- factor(paste(iso2@data$min, "to", iso2@data$max, "mins"))
iso3@data$drive_times <- factor(paste(iso3@data$min, "to", iso3@data$max, "mins"))
iso4@data$drive_times <- factor(paste(iso4@data$min, "to", iso4@data$max, "mins"))
iso5@data$drive_times <- factor(paste(iso5@data$min, "to", iso5@data$max, "mins"))

#Create Colour Palette for each time interval
factPal1 <- colorFactor(rev(heat.colors(12)), iso1@data$drive_times)
factPal2 <- colorFactor(rev(heat.colors(12)), iso2@data$drive_times)
factPal3 <- colorFactor(rev(heat.colors(12)), iso3@data$drive_times)
factPal4 <- colorFactor(rev(heat.colors(12)), iso4@data$drive_times)
factPal5 <- colorFactor(rev(heat.colors(12)), iso5@data$drive_times)

#Draw Map
leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal1(iso1@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso1, popup = iso1@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal2(iso2@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso2, popup = iso2@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal3(iso3@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso3, popup = iso3@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal4(iso4@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso4, popup = iso4@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal5(iso5@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso5, popup = iso5@data$drive_times, group = "Drive Time")%>%
  addLegend("bottomright", pal = factPal1, values = iso1@data$drive_times, title = "Drive Time")  

不知道为什么我不能只参考我制作的空间数据帧？ 像这样...

iso <- osrmIsochrone(loc = c(spatialdf$Longitude,spatialdf$Latitude), breaks = seq(from = 0, to = 60, by = 5))

这给了我错误：中断值不适合栅格值

然后只使用1个多边形来映射所有这些？ 像这样...

leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal(iso@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso, popup = iso@data$drive_times, group = "Drive Time")%>%
  addLegend("bottomright", pal = factPal, values = iso@data$drive_times, title = "Drive Time")  

Answer 1

通过构建项目列表然后遍历管道链来考虑干燥器（即， D on't R epeat Y ownelf）方法：

# LIST OF COORDS
loc_list <- list(c(-2.3827439, 53.425705), c(-0.85074928, 51.325871), 
                 c(-2.939367,51.570344), c(-3.9868026, 55.823102), 
                 c(-0.92104073, 53.709006))

isoc_items <- lapply(loc_list, function(i) {
    iso <- osrmIsochrone(loc = i, breaks = seq(from = 0, to = 60, by = 5))
    iso@data$drive_times <- factor(paste(iso@data$min, "to", iso@data$max, "mins"))

    # NAMED LIST OF TWO ITEMS 
    list(iso = iso, factPal = colorFactor(rev(heat.colors(12)), iso@data$drive_times))
})


leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  addMarkers(data = spatialdf, lng = spatialdf$Longitude, 
             lat = spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%

  # ITERATE TO ADD POLYGONS
  for (item in isoc_items) { 
      addPolygons(fill = TRUE, stroke = TRUE, color = "black", 
                  fillColor = ~item$factPal(item$iso@data$drive_times), 
                  weight = 0.5, fillOpacity = 0.2, data = item$iso, 
                  popup = item$iso@data$drive_times, group = "Drive Time")%>%
  }

  addLegend("bottomright", pal = isoc_items[[1]]$factPal, 
            values = isoc_items[[1]]$iso@data$drive_times, title = "Drive Time") 

Answer 2

@Parfait很好地利用了我会保留的lapply，所以我不会为了我的答案重新创建它。 对于在调用addPolygon时只想查看一个空间多边形数据帧的问题，可以在创建后使用rbind。 请注意，这仅使用一个colorFactor集。

#Create Isochrone points
iso1 <- osrmIsochrone(loc = c(-2.3827439,53.425705), breaks = seq(from = 0, to = 60, by = 5))
iso2 <- osrmIsochrone(loc = c(-0.85074928,51.325871), breaks = seq(from = 0, to = 60, by = 5)) 
iso3 <- osrmIsochrone(loc = c(-2.939367,51.570344), breaks = seq(from = 0, to = 60, by = 5)) 
iso4 <- osrmIsochrone(loc = c(-3.9868026,55.823102), breaks = seq(from = 0, to = 60, by = 5)) 
iso5 <- osrmIsochrone(loc = c(-0.92104073,53.709006), breaks = seq(from = 0, to = 60, by = 5))

iso <- rbind(iso1, iso2,iso3,iso4,iso5)

#Create Drive Time Interval descriptions
iso@data$drive_times <- factor(paste(iso@data$min, "to", iso@data$max, "mins"))

#Create Colour Palette for each time interval
factPal <- colorFactor(rev(heat.colors(12)), iso@data$drive_times)

#Draw Map
leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  # addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal(iso@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso, popup = iso@data$drive_times, group = "Drive Time") %>%
addLegend("bottomright", pal = factPal, values = iso@data$drive_times, title = "Drive Time")