Search code examples
rmapsosrm

How can i plot multiple isochrone polygons using OSRM in R?

I have successfully managed to recreate the drive time polygon in R using This Example Post

The above post only deals with ONE single polygon with isochrones

Problem - I want to plot MULTIPLE drive time polygons on 5 different map points

I have managed to do this in a VERY laborious fashion by creating 5 seperate isochrones, and then adding 5 polygons to my Leaflet Map

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

Not sure why i cannot just refer to the Spatial dataframe that i made ? like this...

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

This gives me the error: break values do not fit the raster values

and then just use 1 polygon to map all of them? like this...

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

  • Consider a DRY-er (i.e., Don't Repeat Yourself) approach by building a list of items and then iterate through the piping chain:

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