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

Question

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

I'm getting an "access denied" error with that link up top. Can you post the data that's in the excel sheet? And the final output you need is a Leaflet plot? — camille, Apr 09 '18 at 16:10
try the link again :) and no cannot post that data. Yes output is a leaflet plot :) thanks — mojo3340, Apr 09 '18 at 16:16
Cool, link works now. But it's going to be hard to help without data we can use to replicate what you're trying to do. If not that exact excel document, maybe you can make example data that's similar — camille, Apr 09 '18 at 16:23
Hi camille, the data is nothing but a list of longitudes and latitudes, with a location name :) if you take any random locations it will still be relevant to this problem — mojo3340, Apr 09 '18 at 16:26

score 4 · Accepted Answer · answered Apr 10 '18 at 21:27

4

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

answered Apr 10 '18 at 21:27

Parfait

104,375
17
94
125

Thanks @Parfait, will take a look at this asap and get back to you – mojo3340 Apr 11 '18 at 14:23
Okay, the isoc_items function is erroring out. I ran the function in debug mode and it pulled out this line as an approximate error... stop(gettextf("unable to find an inherited method for function %s for signature %s", sQuote(fdef@generic), sQuote(cnames)), domain = NA) – mojo3340 Apr 12 '18 at 15:30
This is the general error when the block of code is executed ... OSRM returned an error: Error in function (type, msg, asError = TRUE) : Empty reply from server – mojo3340 Apr 12 '18 at 15:31
even with both lines commented out it still produces the same error. I think its something to do with loc = i? – mojo3340 Apr 12 '18 at 15:52
there does not appear to be any relationship between function i and the rest of the code block? – mojo3340 Apr 12 '18 at 15:58
how do you mean printing i? lol good luck the documentation is limited – mojo3340 Apr 12 '18 at 16:09
starting a new session did nothing. still same error. there are no errors when i do the long form method – mojo3340 Apr 13 '18 at 10:25
Very interesting! Looking at the internals of function on [Git repo](https://github.com/rCarto/osrm/blob/master/R/osrmIsochrone.R), `osrmIsochrone()` calls [`osrmTable()`](https://github.com/rCarto/osrm/blob/master/R/osrmTable.R) and this function actually makes RCurl requests, parsing json data! Hence, the server error since `lapply` is not waiting for request back! A usual issue with web API downloads inside loops. – Parfait Apr 13 '18 at 14:44
Since `lapply` call might be running too fast it does not wait for processing. In long form, does an individual line call take some time (stop button in R Studio) to run? Try adding `Sys.sleep(# of seconds)` just after `osrmIsochrone()`. Play around with the seconds. See `?Sys.sleep`. – Parfait Apr 13 '18 at 14:45
yes that makes sense! the individual calls take a few seconds at least. sorry for the late reply! – mojo3340 Apr 16 '18 at 14:31
also not sure about the placing of Sys.sleep?? – mojo3340 Apr 16 '18 at 14:37
so the Sys.sleep is not solving the function issue. i am still getting an empty reply from the server – mojo3340 Apr 16 '18 at 14:43
Github tells us that the empty reply from server is simply that the remote server is down, so perhaps no actual code issue ,rather it is a server side issue – mojo3340 Apr 16 '18 at 14:51
Although i did not get to a final answer, i can see this answer working there just appears to be some ironing issues that i need to resolve. Thank you for your guidance ! :) – mojo3340 Apr 17 '18 at 14:56
Sounds good. Can you delete your above comments to not confuse future readers? And please come back with more specific issue than server down! I will delete this one. – Parfait Apr 17 '18 at 16:09
Wanted to use this approach but RStudio complains at the end of the for() loop where the polygons are added to the map with ) %>% } : "unexpected token }" I assume this is because of the pipe-operator. Did I miss something here? – Snel Dec 20 '19 at 10:03

score 2 · Answer 2 · answered Apr 16 '18 at 14:33

@Parfait has a good use of lapply that I would keep, so I won't recreate it for my answer. For your question of only looking to refer to one spatial polygon dataframe in your call to addPolygon you can use rbind once they are created. Note this only uses one colorFactor set.

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

i am failing to test both of your answers as the remote server is down so i keep getting an empty reply from server. As soon as that is fixed i will inform both of you! — mojo3340, Apr 16 '18 at 14:51

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

2 Answers2