9

我已经成功地使用此示例帖子在 R 中重新创建了行驶时间多边形

上面的帖子只处理一个具有等时线的单个多边形

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

通过创建 5 个单独的等时线，然后将 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")
4

2 回答 2

4

考虑一个 DRY-er（即D on't R epeat Y ourself ）方法，通过构建项目列表然后遍历管道链：

# 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")
于 2018-04-10T21:27:56.330 回答
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")
于 2018-04-16T14:33:12.120 回答