I've been looking at the nice added functionality of addDrawToolbar in Leaflet/Shiny, which allows for custom drawing of shapes etc.
But i'm interested in sub-setting spatial data by accessing the geometry of the drawn shape, how is this done? There are some efforts here and here but I can't get them to work at any rate.
I thought perhaps that the clever functionality of plot brush might work with leaflet maps but Joe Cheng suggested last year that it wasn't in place.
So, are there any developments or workarounds on this? or has anyone managed to access the geometry of a drawn rectangle using addDrawToolbar?
You could use the addDrawToolbar from the leaflet.extras package.
The docs are sparse but this page has the code for the Leaflet.draw shiny bindings. You can look for the lines that have Shiny.onInputChange and in your the server part of your app, use the corresponding input$event to get the data passed to the Shiny.onInputChange.
Here's a minimal example, you can draw polygons around cities and the names of the cities in the polygon will be displayed below the map:
rm(list=ls())
library(shiny)
library(leaflet)
library(leaflet.extras)
cities <- structure(list(AccentCity = c("Saint Petersburg", "Harare", "Qingdao",
"Addis Abeba", "Xian", "Anshan", "Rongcheng", "Kinshasa", "New York",
"Sydney", "Lubumbashi", "Douala", "Bayrut", "Luanda", "Ludhiana"
), Longitude = c(30.264167, 31.0447222, 120.371944, 38.749226,
108.928611, 122.99, 116.364159, 15.3, -74.0063889, 151.205475,
27.466667, 9.7, 35.5097222, 13.233174, 75.85), Latitude = c(59.894444,
-17.8177778, 36.098611, 9.024325, 34.258333, 41.123611, 23.528858,
-4.3, 40.7141667, -33.861481, -11.666667, 4.0502778, 33.8719444,
-8.836804, 30.9)), class = "data.frame", row.names = c(NA, -15L
), .Names = c("AccentCity", "Longitude", "Latitude"))
cities_coordinates <- SpatialPointsDataFrame(cities[,c("Longitude","Latitude")],cities)
ui <- fluidPage(
leafletOutput("mymap"),
textOutput("selected_cities")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
setView(0,0,2) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addMarkers(data=cities,lat=~Latitude,lng=~Longitude,label=~AccentCity) %>%
addDrawToolbar(
targetGroup='draw',
polylineOptions=FALSE,
markerOptions = FALSE,
circleOptions = TRUE) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
})
output$selected_cities <- renderText({
#use the draw_stop event to detect when users finished drawing
req(input$mymap_draw_stop)
print(input$mymap_draw_new_feature)
feature_type <- input$mymap_draw_new_feature$properties$feature_type
if(feature_type %in% c("rectangle","polygon")) {
#get the coordinates of the polygon
polygon_coordinates <- input$mymap_draw_new_feature$geometry$coordinates[[1]]
#transform them to an sp Polygon
drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){c(x[[1]][1],x[[2]][1])})))
#use over from the sp package to identify selected cities
selected_cities <- cities_coordinates %over% SpatialPolygons(list(Polygons(list(drawn_polygon),"drawn_polygon")))
#print the name of the cities
cities[which(!is.na(selected_cities)),"AccentCity"]
} else if(feature_type=="circle") {
#get the coordinates of the center of the cirle
center_coords <- matrix(c(input$mymap_draw_new_feature$geometry$coordinates[[1]],input$mymap_draw_new_feature$geometry$coordinates[[2]]),ncol=2)
#calculate the distance of the cities to the center
dist_to_center <- spDistsN1(cities_coordinates,center_coords,longlat=TRUE)
#select the cities that are closer to the center than the radius of the circle
cities[dist_to_center < input$mymap_draw_new_feature$properties$radius/1000,"AccentCity"]
}
})
}
shinyApp(ui, server)
Edit:
Added support in case the user draws a circle.
drawing on and adapting NicE's answer above (accepted), this is what I did to subset and zonal sum a raster, using a drawn rectangle.
Crucially i had to swap over
drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){**c(x[[2]][1],x[[1]][1]**)}))) to drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){**c(x[[1]][1],x[[2]][1]**)}))) to make the extract work, otherwise the extent was the wrong way around.
leaf.proj <- "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +a=6378137 +b=6378137 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"
LL <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
r <- raster("myraster.tif")
ui <- fluidPage(
leafletOutput("mymap"),
textOutput("selected_cities")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
setView(0,0,4) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addRasterImage(r,project=FALSE, layerId="rasimg") %>%
addDrawToolbar(
targetGroup='draw',
polylineOptions=FALSE,
markerOptions = FALSE,
circleOptions = FALSE,
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()))%>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
})
output$rastersum <- renderText({
#use the draw_stop event to detect when users finished drawing
req(input$mymap_draw_stop)
# get the coordinates of the polygon and make SpatialPolygons object
polygon_coordinates <- input$mymap_draw_new_feature$geometry$coordinates[[1]]
drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){c(x[[1]][1],x[[2]][1])})))
sp <- SpatialPolygons(list(Polygons(list(drawn_polygon),"drawn_polygon")))
# set coords as latlong then transform to leaflet projection
proj4string(sp) <- LL
polyre <- spTransform(sp, leaf.proj)
e <- extract(r,polyre)
sum(unlist(e),na.rm=T)
})
}
runApp(shinyApp(ui, server), launch.browser = TRUE)
i included editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()) to allow me to delete the drawn polygon but ideally i want it to auto delete when i draw a new one, which i will build in at some point.
