Keep selected layers and map position after filtering dataset using R, Leaflet and Shiny

Question

I'm working a dashboard in R using Shiny and leaflet. It is basically a map that changes when you select a date. What I want to do is to keep the "groups" selected in the same map position after changing the date.

This is a simplified version of my code:

library(leaflet)
library(tidyverse)
library(shiny)

data <- readRDS("data.RDS")
pal_01 <- colorNumeric("YlGnBu", domain = log1p(data$px100m))
pal_02 <- colorNumeric("YlOrBr", domain = log1p(data$fx100m))

ui <- fluidPage(
    titlePanel("TITLE"),
    sidebarLayout(
        sidebarPanel(
            selectInput("PERIODO_ID", "Select PERIODO_ID:",
                        choices=sort(unique(data$PERIODO_ID), decreasing=TRUE),
            ),
        ),
        mainPanel(tabPanel("MAP", leafletOutput("MAP")))
    )
)
 
server <- function(input, output, session) {

    data_f <- reactive({
        x <- data %>% filter(PERIODO_ID==input$PERIODO_ID)
        return(x)
    })

    output$MAP <- renderLeaflet({
        leaflet() %>%
            addTiles(group="OSM") %>%
            addProviderTiles("CartoDB", group="CartoDB") %>%
            addProviderTiles("Esri", group="Esri") %>%
            addPolygons(data=data_f(), weight = 1, color = ~pal_01(log1p(px100m)),group="A") %>%
            addPolygons(data=data_f(), weight = 1, color = ~pal_02(log1p(fx100m)),group="B") %>%
            addLayersControl(baseGroups = c("CartoDB","OSM","Esri"),
                             overlayGroups = c("A","B")) %>%
            hideGroup("A") %>%
            hideGroup("B")
    })
}

shinyApp(ui = ui, server = server)

As you can see, I'm filtering my dataset using PERIODO_ID. I'm using 3 Tiles (OSM, CartoDB, Esri) and plotting 2 layers of polygons (A,B) I want to start my map with no polygons selected, mantaining both baseGroups and overlayGroups according to the user's selection after changing the date. If I could additionally mantain the map position would be awesome.

From what I have read, I tried using leafletProxy and observeEvent but still doesn't work.

Answer 1

If I understand correctly, you want to:

• have the map set to fixed extent rather than panning and zooming to each selected polygon
• not having the selected group disappear when the user selects a different choice

Please next time time provide a fully reproducible example (including data, e.g. the nc dataset that comes with the sf package); I'll assume your data is an sf object.

To solve your map extent issue, calculate the bounding box of your data before filtering: we'll use it later to set the bounds of your leaflet.

bbox <- st_bbox(data)

Currently your leaflet code re-executes completely every time your reactive data_fchanges, which means that you are hiding the groups A and B every time a new selection is made. Instead we'll start with a blank map that just has the structure you need, and then use leafletProxy to update just the polygons.

 output$MAP <- renderLeaflet({
        leaflet() %>%

    # set the view 
            fitBounds(bbox[[1]], bbox[[2]], bbox[[3]], bbox[[4]]) %>%  

            addTiles(group="OSM") %>%
            addProviderTiles("CartoDB", group="CartoDB") %>%
            addProviderTiles("Esri", group="Esri") %>%

    # we don't need the polygons just now, you can delete this
            #addPolygons(data=data_f(), weight = 1, color = ~pal_01(log1p(px100m)),group="A") %>%
            #addPolygons(data=data_f(), weight = 1, color = ~pal_02(log1p(fx100m)),group="B") %>%

            addLayersControl(baseGroups = c("CartoDB","OSM","Esri"),
                             overlayGroups = c("A","B")) %>%
            hideGroup("A") %>%
            hideGroup("B")
    })

# Then you can monitor changes to data_f with an observer, and make the map update accordingly

observeEvent(data_f(), {
      
      leafletProxy("MAP") %>% 
         
         clearShapes() %>% # remove existing selection
         
         # add polygons according to selection
         addPolygons(data=data_f(), weight = 1,color = ~pal_01(log1p(px100m)),group="A") %>%
         addPolygons(data=data_f(), weight = 1, color = ~pal_02(log1p(fx100m)),group="B")
         
   })

Shiny wizards might have even more efficient solutions but I think this should do what you need.