Skip to content

Instantly share code, notes, and snippets.

@mndrake
Created March 29, 2017 00:39
Show Gist options
  • Save mndrake/aee9a0f5c53018860e46766d0131cd29 to your computer and use it in GitHub Desktop.
Save mndrake/aee9a0f5c53018860e46766d0131cd29 to your computer and use it in GitHub Desktop.
Interactive Polygon Brushing with Shiny and Leaflet
# originally from: http://stackoverflow.com/questions/42528400/plot-brushing-or-accessing-drawn-shape-geometry-for-spatial-subsets-in-shiny-lea
# uses https://github.com/bhaskarvk/leaflet.extras
library(shiny)
library(leaflet)
library(leaflet.extras)
library(sp)
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)
@halljonas
Copy link

Nevermind! Found it on the man page.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment