rshinyr-leaflet
Select multiple items using map_click in leaflet, linked to selectizeInput() based on filtered data
I'm creating a shiny app that uses the solution offered by ismirsehregal to (de)select multiple items using map_click and selectizeInput. Select multiple items using map_click in leaflet, linked to selectizeInput() in shiny app (R)
But now I would like to add a pickerInput to first filter the map. So, let's say users can first filter the nc dataset based on "SID79" (something like the below).
library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(shinyWidgets)
#load shapefile
nc_raw <- st_read(system.file("shape/nc.shp", package="sf")) %>%
st_transform(4326)
shinyApp(
ui = fluidPage(
# I added pickerinput to filter based on SID79
pickerInput("select_type",
label = "Select Type",
choices = sort(unique(nc_raw$SID79)),
options = list("actions-box" = TRUE),
multiple = TRUE,
selected = 1),
"Update selectize input by clicking on the map",
leafletOutput("map"),
# I would like the selectize input to update to show all the locations selected by pickerInput,
# when items are removed here, they are removed on the map too, so linked to the map.
# Also users can add areas that are initially deselected due to the pickerInput filter
selectizeInput(inputId = "selected_locations",
label = "selected",
choices = " ",
selected = NULL,
multiple = TRUE)
),
server <- function(input, output, session){
##### Filter regions ####
nc <- reactive({
nc <- filter(nc_raw,
SID79 %in% input$select_type)
})
#create empty vector to hold all click ids
selected_ids <- reactiveValues(ids = vector())
#initial map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = nc_raw,
fillColor = "white",
fillOpacity = 0.5,
color = "black",
stroke = TRUE,
weight = 1,
layerId = ~NAME,
group = "regions",
label = ~NAME) %>%
addPolygons(data = nc(),
fillColor = "red",
fillOpacity = 0.5,
weight = 1,
color = "black",
stroke = TRUE,
layerId = ~CNTY_ID,
group = ~NAME) %>%
# I modified this from hideGroup; Ideally users could still add areas filtered out by
# pickerInput but not sure the best way to do this... another map layer?
showGroup(group = nc()$NAME)
}) #END RENDER LEAFLET
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
# create empty vector to hold all click ids
# selected should initially display all areas selected by pickerInput
selected <- reactiveValues(groups = vector())
observeEvent(input$map_shape_click, {
if(input$map_shape_click$group == "regions"){
selected$groups <- c(selected$groups, input$map_shape_click$id)
proxy %>% showGroup(group = input$map_shape_click$id)
} else {
selected$groups <- setdiff(selected$groups, input$map_shape_click$group)
proxy %>% hideGroup(group = input$map_shape_click$group)
}
updateSelectizeInput(session,
inputId = "selected_locations",
label = "",
choices = nc()$NAME,
selected = selected$groups)
})
observeEvent(input$selected_locations, {
removed_via_selectInput <- setdiff(selected$groups, input$selected_locations)
added_via_selectInput <- setdiff(input$selected_locations, selected$groups)
if(length(removed_via_selectInput) > 0){
selected$groups <- input$selected_locations
proxy %>% hideGroup(group = removed_via_selectInput)
}
if(length(added_via_selectInput) > 0){
selected$groups <- input$selected_locations
proxy %>% showGroup(group = added_via_selectInput)
}
}, ignoreNULL = FALSE)
})
Now the map should update based on select_type filters and populate the selectizeInput display as well. From there, users should be able to add or delete areas by clicking on the map or using selectizeInput. Here is a picture of my app and how I would like this functionality to work:
I've been tweaking ismirsehregal's code for hours and cannot get this to work. It's too complicated for me to make this seemingly simple modification.
Solution
We need to add another observeEvent tracking the reactive nc() to update the choices of selectizeInput "selected_locations".
Please check the following:
library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(shinyWidgets)
#load shapefile
nc_raw <- st_read(system.file("shape/nc.shp", package="sf")) %>%
st_transform(4326)
shinyApp(
ui = fluidPage(
pickerInput("select_type",
label = "Select Type",
choices = sort(unique(nc_raw$SID79)),
options = list("actions-box" = TRUE),
multiple = TRUE,
selected = 1),
"Update selectize input by clicking on the map",
leafletOutput("map"),
"I would like the selectize input to update to show all the locations selected,",
"but also when items are removed here, they are removed on the map too, so linked to the map.",
selectizeInput(inputId = "selected_locations",
label = "Selected:",
choices = NULL,
selected = NULL,
multiple = TRUE)
),
server <- function(input, output, session){
##### Filter regions ####
nc <- reactive({
filter(nc_raw, SID79 %in% input$select_type)
})
observeEvent(nc(), {
updateSelectizeInput(session,
inputId = "selected_locations",
choices = nc()$NAME,
selected = input$selected_locations)
})
#create empty vector to hold all click ids
selected_ids <- reactiveValues(ids = vector())
#initial map output
output$map <- renderLeaflet({
req({NROW(nc()) > 0})
leaflet() %>%
addTiles() %>%
addPolygons(data = nc(),
fillColor = "white",
fillOpacity = 0.5,
color = "black",
stroke = TRUE,
weight = 1,
layerId = ~NAME,
group = "regions",
label = ~NAME) %>%
addPolygons(data = nc(),
fillColor = "red",
fillOpacity = 0.5,
weight = 1,
color = "black",
stroke = TRUE,
layerId = ~CNTY_ID,
group = ~NAME) %>%
hideGroup(group = setdiff(nc()$NAME, input$selected_locations)) # nc()$CNTY_ID
}) #END RENDER LEAFLET
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
#create empty vector to hold all click ids
selected <- reactiveValues(groups = vector())
observeEvent(input$map_shape_click, {
if(input$map_shape_click$group == "regions"){
selected$groups <- c(selected$groups, input$map_shape_click$id)
proxy %>% showGroup(group = input$map_shape_click$id)
} else {
selected$groups <- setdiff(selected$groups, input$map_shape_click$group)
proxy %>% hideGroup(group = input$map_shape_click$group)
}
updateSelectizeInput(session,
inputId = "selected_locations",
choices = nc()$NAME,
selected = selected$groups)
})
observeEvent(input$selected_locations, {
removed_via_selectInput <- setdiff(selected$groups, input$selected_locations)
added_via_selectInput <- setdiff(input$selected_locations, selected$groups)
if(length(removed_via_selectInput) > 0){
selected$groups <- input$selected_locations
proxy %>% hideGroup(group = removed_via_selectInput)
}
if(length(added_via_selectInput) > 0){
selected$groups <- input$selected_locations
proxy %>% showGroup(group = added_via_selectInput)
}
}, ignoreNULL = FALSE)
})
Edit: OPs additional request, deselect groups:
library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(shinyWidgets)
#load shapefile
nc_raw <- st_read(system.file("shape/nc.shp", package="sf")) %>%
st_transform(4326)
shinyApp(
ui = fluidPage(
pickerInput("select_type",
label = "Select Type",
choices = sort(unique(nc_raw$SID79)),
options = list("actions-box" = TRUE),
multiple = TRUE,
selected = 1),
"Update selectize input by clicking on the map",
leafletOutput("map"),
"I would like the selectize input to update to show all the locations selected,",
"but also when items are removed here, they are removed on the map too, so linked to the map.",
selectizeInput(inputId = "selected_locations",
label = "Selected:",
choices = NULL,
selected = NULL,
multiple = TRUE)
),
server <- function(input, output, session){
##### Filter regions ####
nc <- reactive({
filter(nc_raw, SID79 %in% input$select_type)
})
observeEvent(nc(), {
updateSelectizeInput(session,
inputId = "selected_locations",
choices = nc()$NAME,
selected = nc()$NAME) # input$selected_locations
})
#create empty vector to hold all click ids
selected_ids <- reactiveValues(ids = vector())
#initial map output
output$map <- renderLeaflet({
req({NROW(nc()) > 0})
leaflet() %>%
addTiles() %>%
addPolygons(data = nc(),
fillColor = "white",
fillOpacity = 0.5,
color = "black",
stroke = TRUE,
weight = 1,
layerId = ~NAME,
group = "regions",
label = ~NAME) %>%
addPolygons(data = nc(),
fillColor = "red",
fillOpacity = 0.5,
weight = 1,
color = "black",
stroke = TRUE,
layerId = ~CNTY_ID,
group = ~NAME)
# %>% hideGroup(group = setdiff(nc()$NAME, input$selected_locations)) # nc()$CNTY_ID
}) #END RENDER LEAFLET
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
#create empty vector to hold all click ids
selected <- reactiveValues(groups = vector())
observeEvent(input$map_shape_click, {
if(input$map_shape_click$group == "regions"){
selected$groups <- c(selected$groups, input$map_shape_click$id)
proxy %>% showGroup(group = input$map_shape_click$id)
} else {
selected$groups <- setdiff(selected$groups, input$map_shape_click$group)
proxy %>% hideGroup(group = input$map_shape_click$group)
}
updateSelectizeInput(session,
inputId = "selected_locations",
choices = nc()$NAME,
selected = selected$groups)
})
observeEvent(input$selected_locations, {
removed_via_selectInput <- setdiff(selected$groups, input$selected_locations)
added_via_selectInput <- setdiff(input$selected_locations, selected$groups)
if(length(removed_via_selectInput) > 0){
selected$groups <- input$selected_locations
proxy %>% hideGroup(group = removed_via_selectInput)
}
if(length(added_via_selectInput) > 0){
selected$groups <- input$selected_locations
proxy %>% showGroup(group = added_via_selectInput)
}
}, ignoreNULL = FALSE)
})
- Calculate transition probabilities
- How to subset R dataframe based on specific values in several columns?
- Change colon to period in figure caption in Quarto
- Applying different functions to different groups using 2 data frames
- Disable button for 5 seconds with different label and change after it
- How to group columns with an odd index, based on columns with an even index?
- Different plots of marginal effects with interaction term and offset when using different packages
- Animate a MWE GIF in R
- populating a matrix by rows
- How to relevel in ROC curve in R/plotROC?
- R - glmer different results on different machines (non-deterministic)
- Dynamically operate on column (inside :=)
- Random change in obj_addr() output when including the objects into a list and vectorizing over them
- Add to curly-curly argument
- h2o predict error: Test/Validation dataset has no columns in common with the training set
- Is is possible to convert a dataframe object to a tribble constructor?
- encoding issues in R
- How to Scrape NBA stats page using rvest
- Conversion of Decimal Minutes Seconds into Decimal Degrees when cells within the Columns Contains the Factor 'Missed' in R
- Difficulty using case_when() to add column that, conditionally, pastes value from another column
- Flip the matrix
- Creating test for date columns incorrectly throwing error
- Exists() and getSymbols() can't find symbol listed in yahoo
- spearman's rho plot
- Use OpenMP on M2 Mac with R and data.table
- How to find the connected instances from a minimum spanning trees model in R
- Hide a column in shiny datatable but keep it searchable
- How to extract data from an edited datatable in shiny?
- Render Data Table with double header
- filter dataTables in Shiny Dashboad based on selectInput Values