I'm building an R Shiny app. I want reactive plots (plotly) that highlight one or more counties when they are clicked on the map (leaflet). When a highlighted county is clicked again, I want it to be removed.
Ideally I'd also like the reverse, where clicking on a bar in the plot also highlights it and the respective county on the map, but that is a lower priority.
I have tried to adapt code from multiple related posts (especially Changing styles when selecting and deselecting multiple polygons with Leaflet/Shiny and R leaflet highlight options), but can't figure it out.
Problems to solve:
- Proxy adds new polygons but does not remove when clicked a second time
- I want the proxy to have a green outline so that the original choropleth is still visible, but instead it fills it in all white.
- I want to apply the same type of proxy update to the plotly bar chart, but I'm waiting to do that until I figure it out with the leaflet.
Here is a simple reprex using a dummy dataset and percent variable like what I will be using.
#MAP REPREX
library(sf)
library(shiny)
library(tidyverse)
library(leaflet)
library(leaflet.extras)
library(tidycensus)
library(plotly)
library(htmltools)
# GET DATA
NC_counties <- tigris::counties("North Carolina", cb=TRUE, year=2018)%>% st_as_sf()%>% st_transform(crs=4326)
NC_counties <- NC_counties %>% mutate(
pct_water = AWATER/(ALAND+AWATER)*100)
# UI
ui <- fluidPage(
tabsetPanel(id="page1",
tabPanel("Data Tracker",
fluidRow(column(6, leafletOutput("my_map", height = 300)),
column(6, plotlyOutput("comp_bars", height=300))),
tabPanel("About the data")))
)
# SERVER
server <- function(input,output, session){
# CHOROPLETH MAP OF NC COUNTIES
output$my_map = renderLeaflet({
data <- NC_counties
var <- NC_counties$pct_water
bins <- c(0,1,5,10,50,100)
pal <- colorBin(palette = c("#dde4e6","#547980"),
domain = var,
bins = bins,
na.color="#cfcfcf")
labels <- sprintf("%s County", data$NAME)%>% lapply(htmltools::HTML)
leaflet(data,
options=leafletOptions(minZoom=6, maxZoom=6, zoomControl=FALSE))%>%
setView(-80, 34.7, 6) %>%
setMapWidgetStyle(list(background= "white"))%>%
addPolygons(
fillColor = ~pal(var),
fillOpacity = 1,
color = "white",
weight = 1,
layerId=~GEOID,
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto")) %>%
addLegend(pal = pal,
values = ~var,
opacity = 1,
title = "Percent water",
position = "bottomleft")
})
# I WANT A PROXY MAP THAT UPDATES TO HIGHLIGHT ONE OR MORE COUNTIES (THAT GET REMOVED ON THE SECOND CLICK)
clicklist <- reactiveValues(ids=vector())
observe({
click <- input$my_map_shape_click
clicklist$ids <- c(clicklist$ids, click$id)
selected <- NC_counties[as.character(NC_counties$GEOID) %in% clicklist$ids, ]
proxy <- leafletProxy("my_map")
proxy %>%
addPolygons(data = selected,
layerId = ~GEOID,
color = "#9DE0AD",
weight = 3,
opacity = 1,
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto"))
})
# TOTAL CLAIMS BY COUNTY LINE CHART
output$comp_bars <- renderPlotly({
NC_counties$NAME <- factor(NC_counties$NAME, levels = unique(NC_counties$NAME)[order(NC_counties$pct_water)])
ylabs <- list(
title = NULL,
showticklabels = FALSE
)
fig <- plot_ly(
x=NC_counties$pct_water,
y=NC_counties$NAME,
name = "Percent water",
type = "bar",
orientation = 'h',
marker = list(color = "#cfcfcf"))
fig <- fig %>% layout(yaxis=ylabs)
fig
})
# UPDATE BAR CHART WITH SELECTED POLYGONS
observeEvent(input$my_map_shape_click, {
click <- input$my_map_shape_click
clicklist$ids <- c(clicklist$ids, click$id)
selected <- NC_counties[GEOID %in% clicklist$ids, ]
})
}
# SHINY APP
shinyApp(ui, server)
#MAP REPREX
library(sf)
library(shiny)
library(tidyverse)
library(leaflet)
library(leaflet.extras)
library(tidycensus)
library(plotly)
library(htmltools)
# GET DATA
NC_counties <- tigris::counties("North Carolina", cb=TRUE, year=2018)%>% st_as_sf()%>% st_transform(crs=4326)
NC_counties <- NC_counties %>% mutate(
pct_water = AWATER/(ALAND+AWATER)*100)
# UI
ui <- fluidPage(
tabsetPanel(id="page1",
tabPanel("Data Tracker",
fluidRow(column(6, leafletOutput("my_map", height = 300)),
column(6, plotlyOutput("comp_bars", height=300))),
tabPanel("About the data")))
)
# SERVER
server <- function(input,output, session){
# CHOROPLETH MAP OF NC COUNTIES
output$my_map = renderLeaflet({
data <- NC_counties
var <- NC_counties$pct_water
bins <- c(0,1,5,10,50,100)
pal <- colorBin(palette = c("#dde4e6","#547980"),
domain = var,
bins = bins,
na.color="#cfcfcf")
labels <- sprintf("%s County", data$NAME)%>% lapply(htmltools::HTML)
leaflet(data,
options=leafletOptions(minZoom=6, maxZoom=6, zoomControl=FALSE))%>%
setView(-80, 34.7, 6) %>%
setMapWidgetStyle(list(background= "white"))%>%
addPolygons(
fillColor = ~pal(var),
fillOpacity = 1,
color = "white",
weight = 1,
layerId=~GEOID,
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto")) %>%
addLegend(pal = pal,
values = ~var,
opacity = 1,
title = "Percent water",
position = "bottomleft")
})
# I WANT A PROXY MAP THAT UPDATES TO HIGHLIGHT ONE OR MORE COUNTIES (THAT GET REMOVED ON THE SECOND CLICK)
clicklist <- reactiveValues(ids=vector())
observeEvent(input$my_map_shape_click, {
click <- input$my_map_shape_click
proxy <- leafletProxy("my_map")
# gather previous and new clicks in single vector
clicklist$ids <- c(clicklist$ids, click$id)
# subset data
selected <- NC_counties[as.character(NC_counties$GEOID) %in% clicklist$ids, ]
#if the current click ID exists in the clicked polygon (if it has been clicked twice)
if(click$id %in% selected$GEOID){
#define vector that subsets NAME that matches first click ID
duplicates <- selected$GEOID[selected$GEOID == click$id]
# remove the current click$id AND its name match from the selected shapefile
clicklist$ids <- clicklist$ids[!clicklist$ids %in% click$id]
clicklist$ids <- clicklist$ids[!clicklist$ids %in% duplicates]
#remove that highlighted polygon from the map
proxy %>% removeShape(layerId = click$id)
} else {
# map highlighted polygons
proxy %>%
addPolygons(data = selected,
layerId = ~GEOID,
color = "#9DE0AD",
fillOpacity=0,
weight = 3,
opacity = 1,
highlight = highlightOptions(weight = 0,
color = NA,
bringToFront = T),
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto"))
}
})
# TOTAL CLAIMS BY COUNTY LINE CHART
output$comp_bars <- renderPlotly({
NC_counties$NAME <- factor(NC_counties$NAME, levels = unique(NC_counties$NAME)[order(NC_counties$pct_water)])
ylabs <- list(
title = NULL,
showticklabels = FALSE
)
fig <- plot_ly(
x=NC_counties$pct_water,
y=NC_counties$NAME,
name = "Percent water",
type = "bar",
orientation = 'h',
marker = list(color = "#cfcfcf"))
fig <- fig %>% layout(yaxis=ylabs)
fig
})
# UPDATE BAR CHART WITH SELECTED POLYGONS
# to do with plotlyProxy() after map gets resolved
}
# SHINY APP
shinyApp(ui, server)
