Changing styles when selecting and deselecting multiple polygons with Leaflet/Shiny - r

I'm having some problems changing polygon styles when selecting and deselecting polygons in a Leaflet Shiny app I'm working on. In my current app, when you click on a polygon, that polygon is highlighted with a different color. Ideally, I want the user to be able to select and highlight multiple polygons. I also want the user to be able to re-click a single highlighted polygon to deselect it.
The best that I've been able to manage is to select multiple polygons, give them the same group ID "selected", then deselect that entire group when a polygon is re-clicked. Here's some example/reproducible code:
library(raster)
library(shiny)
library(leaflet)
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)
shinyApp(
ui = fluidPage(
leafletOutput("map")
),
server <- function(input, output, session){
#initial map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "white",
fillOpacity = 1,
color = "black",
stroke = T,
weight = 1,
layerId = rwa#data$OBJECTID,
group = "regions")
}) #END RENDER LEAFLET
observeEvent(input$map_shape_click, {
#create object for clicked polygon
click <- input$map_shape_click
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
#subset regions shapefile by the clicked on polygons
selectedReg <-rwa[rwa#data$OBJECTID == click$id,]
#map clicked on polygons
proxy %>% addPolygons(data = selectedReg,
fillColor = "red",
fillOpacity = 1,
weight = 1,
color = "black",
stroke = T,
group = "selected",
# layerId = "selected")
layerId = selectedReg#data$OBJECTID)
#remove polygon group that are clicked twice
if(click$group == "selected"){
proxy %>%
clearGroup(group = "selected")
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
In the above example, every clicked polygon turns red. If a previously-selected red polygon is clicked again, every red polygon is cleared from the map, leaving the initial white polygon renderings.
I can accomplish the desired selecting/deselecting effect when I'm working with only one polygon at a time by using the string layerId "selected" (commented out in the above code), but doing that removes my ability to select and highlight multiple polygons at the same time.
I'm open to any and all suggestions!

The answer lies in layerIds. I wasn't understanding how these were applied to my polygons and removing shapes--understanding this is key. This might not be the most elegant solution, but it gets the job done!
In the below code, the initial map rendering of Rwanda has a layerId of rwa#data$NAME_1, which are the region names. You can see this in action with the label also being set as rwa#data$NAME_1. So in the below image, the leftmost polygon is labeled as Iburengerazuba, its attribute in the NAME_1 column. This layerId sets the click$id for any click events you have on this initial map rendering. So, just as this polygon is labeled Iburengerazuba, its click$id will also be set as Iburengerazuba. As stated in the Leaflet Shiny documentation, if you've got more than one polygon, this needs to be a vectorized argument. If you only need to select and deselect ONE polygon (so only one region at a time, in this example), you could use a layerId string, as I mentioned in my question (such as layerId = "selected").
Next up is the observeEvent for your shape click. Thanks to the help of user #John Paul, I figured out how to save all click events (click ids specifically in this case) made on the map. I saved those in a reactive vector, then subset my shapefile by those click ids. The code is pretty thoroughly commented, so hopefully anyone else looking for this same solution can figure out exactly what's going on.
The final bit of code (housed in the if...else conditional statement) is probably the most confusing. Let's look at the else portion of the code first. (Note: Your initial map click is going to trigger this event because there's no way for the if conditions to have been met upon first click.) If any white polygon is clicked, the addPolygons() call is triggered, adding the clicked polygon onto the map with different styling (in this case, it's red). This is plotting an entirely different polygon on top of the leafletProxy object!
The key to removing the red clicked polygons is giving these polygons a different layerId than the initial map rendering. Note that in the above image, the white polygon that was labeled Iburengerazuba is now labeled as 3. This is because the layerId in the second addPolygons call is set as CC_1 INSTEAD OF NAME_1. So, bottom layer white map has a NAME_1 layerID and therefore NAME_1 click ids, whereas any red clicked polygon plotted on top of that has a CC_1 layerId and therefore CC_1 click ids.
The if statements states that if your click$id already exists in the clickedPolys polygon, that this shape is removed. This is kind of confusing, so again, it might help to go through each line of code and play around with it to truly understand.
Again using the above example, clicking the leftmost polygon adds the layerId Iburengerazuba to the clickedIds$ids vector. This click event triggers a second map drawing, plotting the clicked polygon on top of itself in a different style and with a layerId of 3 (from the CC_1 column). We want to say that if any red polygon is clicked twice (if(click$id %in% clickedPolys#data$CC_1)), it counts as a deselection, and that polygon should be removed from the map. So if you click on the red leftmost polygon with a layerId of 3, the clickedIds$ids vector will be comprised of Iburengerazuba and 3. Iburengerazuba in the NAME_1 column of the clickedPolys polygon corresponds to 3 in the CC_1 column, triggering the if statement. The call removeShape(layerId = click$id) means to remove the shape that corresponds to that click$id. So in this case, the clickedPolys polygon with a CC_1 layerId of 3.
Keep in mind that every click id, both NAME_1 and CC_1 are being recorded in your clickedIds$ids vector. This vector is subsetting your Rwanda shapefile to map all clicked polygons, so as you're clicking polygons, the clickedPolys polygon is dynamically updating (use print calls to check every bit of code if this isn't making sense to you!). Removing any double-clicked shape isn't enough to plot everything correctly--you need to remove deselected layerIds, both NAME_1 and CC_1, from the clickedIds$ids vector. I matched each deselected CC_1 layerId to its corresponding NAME_1 value and removed both of those attributes from the clickedIds$ids vector so that they are removed from the clickedPolys polygon.
Voila! Now you can select and deselect any polygons you want!
library(raster)
library(shiny)
library(leaflet)
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)
shinyApp(
ui = fluidPage(
leafletOutput("map")
),
server <- function(input, output, session){
#create empty vector to hold all click ids
clickedIds <- reactiveValues(ids = vector())
#initial map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "white",
fillOpacity = 1,
color = "black",
stroke = T,
weight = 1,
layerId = rwa#data$NAME_1,
group = "regions",
label = rwa#data$NAME_1)
}) #END RENDER LEAFLET
observeEvent(input$map_shape_click, {
#create object for clicked polygon
click <- input$map_shape_click
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
#append all click ids in empty vector
clickedIds$ids <- c(clickedIds$ids, click$id)
#shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
clickedPolys <- rwa[rwa#data$NAME_1 %in% clickedIds$ids, ]
#if the current click ID [from CC_1] exists in the clicked polygon (if it has been clicked twice)
if(click$id %in% clickedPolys#data$CC_1){
#define vector that subsets NAME that matches CC_1 click ID
nameMatch <- clickedPolys#data$NAME_1[clickedPolys#data$CC_1 == click$id]
#remove the current click$id AND its name match from the clickedPolys shapefile
clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% click$id]
clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% nameMatch]
#remove that highlighted polygon from the map
proxy %>% removeShape(layerId = click$id)
} else {
#map highlighted polygons
proxy %>% addPolygons(data = clickedPolys,
fillColor = "red",
fillOpacity = 1,
weight = 1,
color = "black",
stroke = T,
label = clickedPolys#data$CC_1,
layerId = clickedPolys#data$CC_1)
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP

Related

Changing color for two groups in leaflet for flow map (R)

I have replicated the flow map from a template (here).
I was wondering how I could change the color by grouping. Right now, I have modified the template so that all flows going to the same destination have the same color. However, I was wondering if instead, it would be possible to change the colors for the origins as well, but grouped together. So for example, all flows to Colorado would be different shades of blue, all flows to Texas would be different shades of orange, etc.
The below code is exact same as the linked source, except I have switched "origins" to "destinations"
pal <- colorFactor(brewer.pal(4, 'Set2'), flows$destinations)
leaflet() %>%
addProviderTiles('CartoDB.Positron') %>%
addPolylines(data = flows, weight = ~rootcounts, label = hover,
group = ~destinations, color = ~pal(destinations)) %>%
addLayersControl(overlayGroups = unique(flows$destinations),
options = layersControlOptions(collapsed = FALSE))
Thank you in advance!

Can I use in r the leaflet "map_shape_click" event to populate a box() with a datatable?

I have been searching the web for weeks trying to find an example or a code for what I am trying to accomplish with my shiny app (shinydashboard). I’m new to r and I’m starting to think that what I am trying to do is not possible. I basically have a leaflet map with a county polygon (shapefile) and I want to use the click event on the polygon to open a related dataTable (species table) on a box() below the map. The polygon data is a shapefile containing the county name and county number id. The related dataTable contain the county name, county #id and names of species for each county (one-to-many relationship). I was thinking that some how I could use the observe function and county # id from the “map_shape_click” to render the table with the names of the species by county on a output box(). However I don’t know if that is even possible. So far I was able to create the map and use the click event to capture the county name on a box() ( see attached image).
This forum is amazing and I have learn a lot from the postings. Thank everyone that contribute to the community. If you have any suggestions how I can accomplish this task please let me know,
Thanks
JB
Example image
let see if I got it right..
You can get the desired result by capturing the info related to hte clicked polygon and then using the id to subset your table
library(raster)
library(shiny)
library(leaflet)
library(RColorBrewer)
library(DT)
#species per region
mydata<-data.frame(myID=c("Iburengerazuba", "Iburasirazuba","Umujyi wa
Kigali","Umujyi wa Kigali", "Amajyaruguru", "Iburengerazuba",
"Amajyaruguru", "Amajyaruguru"),
myspec=c("virginiana", "setosa", "barbosa", "pelosa",
"pudica","pudica","pudica","pudica"))
#load in shapefiles for state
states <- getData("GADM", country = "rwa", level = 1)
#define color palettes for states
statePal <- colorFactor("Dark2", states#data$NAME_1)
shinyApp(
ui = fluidPage(
leafletOutput('myMap', width = "100%"),
br(),
DT::dataTableOutput("mytable", width = "100%")
),
server <- function(input, output, session){
output$myMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = states,
fillColor = ~statePal(states#data$NAME_1),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1,
layerId = states#data$NAME_1)
})
observeEvent(input$myMap_shape_click, {
#capture the info of the clicked polygon
click <- input$myMap_shape_click
#subset your table with the id of the clicked polygon
selected <- mydata[mydata$myID == click$id,]
#if click id isn't null render the table
if(!is.null(click$id)){
output$mytable = DT::renderDataTable({
selected
})
}
})
})

Making persistant selections in Plotly’s legend for animations

I am trying to use plotly in R with shiny to animate the movement of XY data points (x = Population, y = Cars) over time for a number of global cities. Each city is grouped/colored by the continent that it is in (i.e. all cities in Asia are coloured the same, all cities in Europe are colored the same, etc). Everything at this stage, including the animation, already works fine with the play button and the date slider correctly working to show the movement of these cities’ results over time.
My problem is that my selections/de-selections of specific continents within the chart’s legend doesn’t persist when animating the chart. For example, if I toggle ‘Europe’ in the legend of the plotly chart, as expected all the data points associated with European cities will disappear. However if I then click the play button to run the animation, the European data points reappear again when they should stay hidden. Is there a plotly setting I can change so that my selections within the legend don’t reappear when I animate?
I have attached 2 images below showing this problem.
1: I have deselected ‘Europe’ from the legend and it is now greyed out. All the European data points disappear as expected. No problems here yet.
#1
2: This is where the problem is. Despite ‘Europe’ still being deselected in the legend, the orange/European data points reappear when dragging the date slider to the next day. Is there a way to ensure that they stay hidden?
#2
I have copied my R code with shiny below.
Thanks for your help!
server.R
library("shiny")
library ("ggplot2")
library ("plotly")
setwd ("C:/Desktop")
file.names <- list.files (pattern = ".csv", recursive = TRUE)
imported <- sapply (file.names, read.csv, header = TRUE, simplify = FALSE)
names (imported) <- gsub (".csv", "", names(imported))
names (imported) <- strptime (names(imported), "%Y%m%d")
for (i in 1:length(imported)) {
imported[[i]]$Date <- names(imported[i])
}
imported <- do.call (rbind, imported)
imported <- as.data.frame (imported)
shinyServer(function(input, output) {
output$chart.animate <- renderPlotly({
chart.xy <- plot_ly()
chart.xy <- add_markers(chart.xy, x = ~Population, y = ~Cars, color = ~Continent, frame = ~Date, ids =~City, data = imported)
chart.xy <- animation_opts(chart.xy, redraw = FALSE)
return (chart.xy)
})
})
ui.R
library("shiny")
shinyUI(fluidPage(
mainPanel(
plotlyOutput('chart.animate')
)
))
In Python3, you can make persistent selections in legend entries through animations by placing all the entries into legend groups with “legendgroup” = “[group name]” in the data dictionaries.
If you put all of the “Asia” series into one legendgroup (and likewise for the other series), your selection / deselection will persist through animations.

Is it possible to access R Leaflet layer controls in Shiny (outside of leaflet)?

I'm working on creating a Shiny/Leaflet app similar to this one that's done in tableau. It shows world-level views of poverty for different years, allowing the user to filter the map by variable, region, and year.
The problem is that the global country-level shapefile (from NaturalEarthData) renders quite slowly. I'm working on different ways to simplify those polygons to decrease load time, but in the meantime, I'm working on other potential solutions.
Ideally, I would use Shiny controls to toggle the different map layers and use leafletProxy to update the map. But because each layer change draws the entire map again, this is also quite slow.
When I include the different layers inside Leaflet, the layers are rendered much, much faster. (I assume that this is because the addLayersControl option in Leaflet only changes the fillColor of the polygons rather than redrawing the entire global shapefile, as is done with leafletProxy). But is there any way to access these layers outside of Leaflet?
To illustrate, here's some dummy code:
#load required libraries
library(shiny)
library(leaflet)
library(raster)
#begin shiny app
shinyApp(
ui <- fluidPage(
leafletOutput("map", width = "100%", height = 600)
), #END UI
server <- function(input, output, session){
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 0)
#render map
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "blue",
group = "blue") %>%
addPolygons(data = rwa,
fillColor = "red",
group = "red") %>%
addLayersControl(baseGroups = c("blue", "red"),
options = layersControlOptions(collapsed = F))
}) #END RENDER LEAFLET
} #END SERVER
) #END SHINY APP
Which has the following output:
You can easily toggle between the blue and red layers within the leaflet map object. But let's say that I want a Shiny table to update with the attributes from the red polygon layer when I toggle the map layers from blue to red. I want to be able to pull this object outside of leaflet and utilize it in a Shiny observeEvent. Is this possible/how can I do this?
You can define an observer for the {MAP_ID}_groups input in your Shiny server.
Example:
server <- function(input, output, session) {
# ...
output$my_map <- renderLeaflet({
# ...
})
observe({
selected_groups <- req(input$my_map_groups)
# do whatever ...
})
}
This input gets updated when the user selects a group in the layers control.

Zooming into State to view ZipCode using R Leaflet

I am using R leaftlet package to create a interactive choropleth of the U.S.
There are several tutorials online and I am able to create interactive state level map with popups and zooming. Also I was also able to create a separate zip code level map again with popups.
I would like both views in one map itself but make zip code visible as I zoom in a state or double click on a state. Like If I double click on New York, the New York Zip Code opens up. Is there a package/function in R that can help me do this?
Here are static screenshots of both to make things clear what I plan to integrate.
I agree with Yehoshapat Schellekens that in R one might not have the flexibility of a web programming language. But seldom R is not flexible enough to achieve fancy results! :) Here you go with a "vanilla" example of what you basically need. You can customize the windows popup with some JS.
library(shiny)
library(leaflet)
library(maps)
library(maptools)
library(sp)
library(rgeos)
mapStates = map("state", fill = TRUE, plot = FALSE)
mapCounty = map("county", fill = TRUE, plot = FALSE)
shinyApp(
ui = fluidPage(leafletOutput('myMap'),
br(),
leafletOutput('myMap2')),
server <- function(input, output, session) {
output$myMap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(lng = mapStates$x,
lat = mapStates$y,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(is.null(click))
return()
lat <- click$lat
lon <- click$lng
coords <- as.data.frame(cbind(lon, lat))
point <- SpatialPoints(coords)
mapStates_sp <- map2SpatialPolygons(mapStates, IDs = mapStates$names)
i <- point [mapStates_sp, ]
selected <- mapStates_sp [i]
mapCounty_sp <- map2SpatialPolygons(mapCounty, IDs = mapCounty$names)
z <- over(mapCounty_sp, selected)
r <- mapCounty_sp[(!is.na(z))]
output$myMap2 <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(data=r,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
})
})
NOTE: The datasets used in the example seem to have different accuracies (not perfect overlap for states and counties). Therefore the spatial matching is accounting for more counties than expected (those inside plus those intersecting the state borders). Use the name as ID instead to achive the perfect match.
I've created the same type of app working off of G. Cocca's code, and after a few months of fiddling with it over and over, I've come up with a more elegant solution to your problem. For simple reproducibility, I'm using Rwanda shapefiles as an example (because they're much smaller than GADM's USA shapefiles, but you can always just replace these with your own US shapefiles).
library(raster)
library(shiny)
library(leaflet)
library(RColorBrewer)
#load in shapefiles for state and county level
states <- getData("GADM", country = "rwa", level = 1)
counties <- getData("GADM", country = "rwa", level = 2)
#define color palettes for states
pal <- brewer.pal(8, "Dark2")
statePal <- colorFactor(pal, states#data$NAME_1)
shinyApp(
ui = fluidPage(
leafletOutput('myMap', width = "100%"),
br(),
leafletOutput("myMap2", width = "100%")
), #END UI
server <- function(input, output, session){
#default state level map output
output$myMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = states,
fillColor = ~statePal(states#data$NAME_1),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1,
layerId = states#data$NAME_1) #this sets the click id, very important!
}) #END RENDERLEAFLET OUTPUT
observeEvent(input$myMap_shape_click, {
#define click object
click <- input$myMap_shape_click
#subset counties shapefile so that only counties from the clicked state are mapped
selected <- counties[counties$NAME_1 == click$id,]
#define color palette for counties
countyPal <- colorFactor(pal, selected#data$NAME_2)
#if click id isn't null (i.e. if ANY polygon is clicked on), draw map of counties
if(!is.null(click$id)){
output$myMap2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = selected,
fillColor = ~countyPal(selected#data$NAME_2),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1)
}) #END RENDERLEAFLET
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
The first output is your state level map. With this code, when you click on a state of interest, a click object is created that has a click$id corresponding the name of that state (which is established in the layerId definition in the addPolygons call). With the click$id as the selected state name, you can then subset your county level polygon by that state and plot it as a map.
The options for designing this map are endless, really. Hope this helps!
You wont be able to create this through R, you need to run this through good old java Script, and specifically leaflet.
Keep in mind that R does not run the map, all it does is to create a java-script template of an HTML file, your Web browser runs the rest (Not R interpreter)
The professional word you are looking for is event binding, which on one click will trig both zooming in your original US map, and open a new map of a state with its zip code.
General instructions (this is all java script, no R!):
go to http://leafletjs.com/reference.html and find events, you need the dblclick event.
Then you'll need to create a function that opens up a new map.
keep in mind that if you want to do sophisticated stuff, R will give you very limited solutions, so my advice is when you need nice java script visualizations just go straight to the source :)
Your requirement needs lot of customization. If you are good in JavaScript just check geojson2svg that gives lot of flexibility. Basically it converts GeoJSON to SVG, that's all then rest you can achieve with plain HTML and JavaScript. Here are some examples.

Resources